Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Exporting orderlist to Word & Updating sheet 1

Status
Not open for further replies.
pookie62

pookie62

Technical User
Oct 22, 2004
139
GB
Hi all,
Is there a sample for this:
I have a sheet with our number of products in stock.
When the number gets beneath a certain value, I need to order those products.
I would like to export to this to Word creating a list of the products and howmuch I need to order to ensure I have enough of them.
I'll post the code I have so far (the SetPrinted isn't working properly..) hopefully that shines some light.. :)

' Automation of Microsoft Word from Excel
' NOTE: There must be a reference to the current Word
' library from TOOLS | REFERENCES within the VBE
' *************************************************************

'Proc12 uses CreateObject to get the Word 97 Automation object.
'Proc12 then proceeds to create a report in a Word document,
'pasting Excel worksheet data and an Excel chart into the document.

Sub ExcelRoutines_Proc12_CreateWordReport()

'Because this module relies on late binding, it is
'necessary to declare constants to be used with PowerPoint.

Const wdWindowStateMaximize As Integer = 1
Const wdNormalView As Integer = 1
Const wdAlignParagraphCenter As Integer = 1
Const wdAnimationShimmer As Integer = 1
Const wdPasteMetafilePicture As Integer = 3
Const wdInLine As Integer = 0
Const wdPageFitFullPage As Integer = 1
Const wdGoToAbsolute As Integer = 1
Const wdGoToLine As Integer = 3

Dim WordDoc As Object
Dim Filename As String
Filename = "Bestel-" & Format(Date, "dd-mm-yy") & ".doc"
Set WordApp = CreateObject("Word.Application")
With WordApp
.Visible = True
.WindowState = wdWindowStateMaximize
.Documents.Add
Set WordDoc = .ActiveDocument
End With

WordDoc.ActiveWindow.View = wdNormalView
With WordApp.Selection
.InsertAfter "Hansie's VBA Code"
.InsertParagraphAfter
.InsertAfter "Automatisch Word rapport vanuit Excel!"
.InsertParagraphAfter
.InsertAfter "Je kan hier natuurlijk van alles zetten " _
& ":"
.InsertParagraphAfter
.MoveRight
End With
With WordDoc.Paragraphs(1).Range
.ParagraphFormat.Alignment = wdAlignParagraphCenter
With .Font
.Name = "Arial"
.Size = 20
.Bold = True
.Animation = wdAnimationShimmer
End With
End With
With WordDoc.Paragraphs(2).Range
With .ParagraphFormat
.SpaceAfter = 12
.Alignment = wdAlignParagraphCenter
End With
With .Font
.Name = "Arial"
.Size = 14
End With
End With

WordDoc.Paragraphs(3).Range.ParagraphFormat.SpaceAfter = 30
Sheets("Bestel").Range("A1:B25").Copy
With WordApp.Selection
.Paste
.TypeParagraph
End With
With WordDoc
.SaveAs Filename
If MsgBox("Bestellijst gemaakt!" _
& vbCrLf & "Bestand is opgeslagen," _
& vbCrLf & vbCrLf & "Wilt u het meteen printen?", _
vbYesNo + vbDefaultButton2 + 32, "Bestellijst") = vbYes Then _
.PrintOut
.Close
End With

Sheets("Voorraad").Range("I3").Select
Set WordDoc = Nothing
WordApp.Quit
Set WordApp = Nothing
End Sub

Sub SetPrinted()

'print unmarked items

Dim wsV As Worksheet
Dim wsB As Worksheet
Set wsV = Worksheets("Voorraad")
Set wsB = Worksheets("Bestel")
Dim rStart As Long
Dim rEnd As Long
Dim r As Long
rStart = wsV.Cells(Rows.Count, 1).End(xlUp).Row + 1
rEnd = wsV.Cells(Rows.Count, 2).End(xlUp).Row
r = rEnd - rStart + 1
For r = 1 To r
'wsB.Range("A1").Value = wsV.Range("B" & rStart + r - 1)
wsB.PrintPreview
If wsB.Range("B" & rStart + r - 1) <> "" Then _
wsV.Range("A" & rStart + r - 1).Value = "x"
Next r
End Sub
 
Sort by date Sort by votes
Hi pookie62,

Any particular reason for automating Word from Excel for this, rather than simply using a LINK field in Word pointing to a named range in Excel?

Cheers
 
Upvote 0 Downvote
Automated orderinglist is what I want to produce..
 
Upvote 0 Downvote
Hi pookie62,

OK, so what isn't the code doing that you want it to do (especially the SetPrinted sub)? And how does the SetPrinted sub relate to the ExcelRoutines_Proc12_CreateWordReport sub?

In you SetPrinted sub, I'd suggest replacing:
Code: 
r = rEnd - rStart + 1
For r = 1 To r
with:
Code: 
For r = 1 To rEnd - rStart + 1
since you existing code resets r to 1 at the begining of the loop and therefore doesn't execute.

On a more general note, you could simplify some of the Word code by using style formatting, instead of re-formatting the one style (probably 'normal') each time. That tends to produce more-easily-maintained Word documents.

Cheers
 
Upvote 0 Downvote
Hi pookie62,

Skip the comment about the loop not executing - it does so provided rEnd > rStart.

Cheers
 
Upvote 0 Downvote
Hi Macropod
Thanks for your replies!
So I should not replace the code as said in your first post ? Just leave it like it is ?

Want it doesn't do..
This list of products is about 250 rows.
So, when I order some of thes products, I want to see that in the Excel sheet and only one time in the Worddoc, to prevent double orderings for the same product.
In the excelsheet there are minimum and maximum values amount of products. WHen the minimum is reached, I need to order that amount to reach the max amount of products in stock.
Hope this makes sense...

Don't know if all this is possible.. ?
 
Upvote 0 Downvote
Hi pookie62,

So how are the data structured? I'm guessing something like:

Item Max Min Current
A 100 15 24
B 420 90 85
C 5 1 4

on your "Voorraad" worksheet and, from this you'd want something like:

Item Order
B 335

on your "Bestel" worksheet, and you want this to appear in your Word document, but I suspect it might be something altogether different.

Cheers
 
Upvote 0 Downvote
Hi pookie62,

In that case, assuming the:
. item descriptions are in column A;
. maximum quantities are in column B;
. minimum quantities are in column C;
. current quantities are in column D,
try:
Code: 
Sub SetPrinted()
'print unmarked items

Dim wsV As Worksheet
Dim wsB As Worksheet
Dim i As Long
Dim j As Long
Set wsV = Worksheets("Voorraad")
'Set wsB = Worksheets("Bestel")
j = 1
' clear and setup up the output sheet
With wsB
    .Cells.ClearContents
    .Range("A1").Value = "Item"
    .Range("B1").Value = "Qty"
End With
' process all stock rows, but ignore the header row
For i = 2 To wsV.UsedRange.Rows.Count
    ' extract items where stock is at or below minimum, and a maximum exists
    If wsV.Range("D" & i).Value <= wsV.Range("C" & i).Value And wsV.Range("B" & i).Value <> "" Then
    ' write out the order
        j = j + 1
        wsB.Range("A" & j).Value = wsV.Range("A" & i).Value
        wsB.Range("B" & j).Value = wsV.Range("B" & i).Value - wsV.Range("D" & i).Value
    End If
    Next i
' preview the order
wsB.PrintPreview
End Sub


Cheers
 
Upvote 0 Downvote
Hi Macropod,
Been a bit busy, sorry for the late respons..
You code is working great ! Thanks very much!!

Now I have another question,if you're still in the mood ;-)
The order is written now, but how to show this on the Voorraad sheet ? To prevent the same order being printed out the next day or so..
Have you got any ideas ?
 
Upvote 0 Downvote
Hi pookie62,

To do that, you'd need at least one more column (say, column E) on your Voorraad sheet, to show the number on order, or the order date. Then you could test that and, if the order has already been placed, not place another order. Simple enough, by adding an extra test to the loop:
Code: 
For i = 2 To wsV.UsedRange.Rows.Count
    ' extract items where stock is at or below minimum, a maximum exists, and the item isn't already on order
    If wsV.Range("D" & i).Value <= wsV.Range("C" & i).Value And wsV.Range("B" & i).Value <> "" And wsV.Range("E" & i).Value <> "" Then
        wsV.Range("E" & i).Value = wsV.Range("B" & i).Value - wsV.Range("D" & i).Value
        ' write out the order
        j = j + 1
        wsB.Range("A" & j).Value = wsV.Range("A" & i).Value
        wsB.Range("B" & j).Value = wsV.Range("E" & i).Value
    End If
Next i
The above code puts the ordered quantity into Column E.

However, you'd also need to ensure that the data in this column are deleted once the order has been filled. Otherwise, you'd never get another order.

Cheers
PS: The above compound testing with two And expressions in an If statement isn't the most efficient way of doing things, but with only a few hundred items to test it makes little difference.
 
Upvote 0 Downvote
Correction:

wsV.Range("E" & i).Value <> ""
should be
wsV.Range("E" & i).Value = 0

Cheers
 
Upvote 0 Downvote
Thanks a lot Macropod !
Gave you a star for being so helpfull.. ;-)
Gonna try this the weekend (don't have the sheet here at work) and let you know the results, oke ?
Cheers !
 
Upvote 0 Downvote
Had the sheet mailed to me and it's working fine.
Last question for now (I think ;-)):
When I want to set the date of ordering on the "Bestel" sheet, I can't use (Now) because that would change every other day I opened the sheet.
Is there a way to set the date of creation and not let that date change ?
Thanks again !!
 
Upvote 0 Downvote
Hi pookie62,

With vba, you could use the Date function to insert a static date. See also the FormatDateTime Function.

Cheers
 
Upvote 0 Downvote
Hi Macropod,
Thanks again mate, you are really great !
I have all things together now, but for some reason the first row of the Voorraad sheet is not treated right in the way of copied to the Bestel sheet and thus in the Word doc.
Also the last row with data on the Voorraad sheet doen't get a date behind it.
Since it's not possible to attach files or PM you the Excel sheet, I'll post the entire code. Maybe there's a simple little error somewhere that I missed..
Code: 
Private Sub Rapporteer_Click()
ExcelRoutines_Proc12_CreateWordReport
CreateOrder
End Sub



' Automation of Microsoft Word from Excel
'   NOTE: There must be a reference to the current Word
'       library from TOOLS | REFERENCES within the VBE
' *************************************************************

'Proc12 uses CreateObject to get the Word 97 Automation object.
'Proc12 then proceeds to create a report in a Word document,
'pasting Excel worksheet data and an Excel chart into the document.

Sub ExcelRoutines_Proc12_CreateWordReport()
    
'Because this module relies on late binding, it is
'necessary to declare constants to be used with PowerPoint.
    
    Const wdWindowStateMaximize As Integer = 1
    Const wdNormalView As Integer = 1
    Const wdAlignParagraphCenter As Integer = 1
    Const wdAnimationShimmer As Integer = 1
    Const wdPasteMetafilePicture As Integer = 3
    Const wdInLine As Integer = 0
    Const wdPageFitFullPage As Integer = 1
    Const wdGoToAbsolute As Integer = 1
    Const wdGoToLine As Integer = 3
    
    Dim WordDoc As Object
    Dim Filename As String
    Filename = "Bestel-" & Format(Date, "dd-mm-yy") & ".doc"
    Set WordApp = CreateObject("Word.Application")
    With WordApp
        .Visible = True
        .WindowState = wdWindowStateMaximize
        .Documents.Add
        Set WordDoc = .ActiveDocument
    End With
    
    WordDoc.ActiveWindow.View = wdNormalView
    With WordApp.Selection
        .InsertAfter "Hansie's VBA Code"
        .InsertParagraphAfter
        .InsertAfter "Automatisch Word rapport vanuit Excel!"
        .InsertParagraphAfter
        .InsertAfter "Je kan hier natuurlijk van alles zetten " _
            & ":"
        .InsertParagraphAfter
        .MoveRight
    End With
    With WordDoc.Paragraphs(1).Range
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        With .Font
            .Name = "Arial"
            .Size = 20
            .Bold = True
            .Animation = wdAnimationShimmer
        End With
    End With
    With WordDoc.Paragraphs(2).Range
        With .ParagraphFormat
            .SpaceAfter = 12
            .Alignment = wdAlignParagraphCenter
        End With
        With .Font
            .Name = "Arial"
            .Size = 14
        End With
    End With
    
    WordDoc.Paragraphs(3).Range.ParagraphFormat.SpaceAfter = 30
    Sheets("Bestel").Range("A1:C25").Copy
        With WordApp.Selection
        .Paste
        .TypeParagraph
    End With
    With WordDoc
        .SaveAs Filename
          If MsgBox("Bestellijst gemaakt!" _
            & vbCrLf & "Bestand is opgeslagen," _
            & vbCrLf & vbCrLf & "Wilt u het meteen printen?", _
            vbYesNo + vbDefaultButton2 + 32, "Bestellijst") = vbYes Then _
        .PrintOut
        .Close
    End With
        
        Sheets("Voorraad").Range("I3").Select
        Set WordDoc = Nothing
        WordApp.Quit
        Set WordApp = Nothing
End Sub
Sub CreateOrder()

Dim wsV As Worksheet
Dim wsB As Worksheet
Dim i As Long
Dim j As Long
Set wsV = Worksheets("Voorraad")
Set wsB = Worksheets("Bestel")
j = 1
' clear and setup up the output sheet
With wsB
    .Cells.ClearContents
    .Range("A1").Value = "Artikel"
    .Range("B1").Value = "Aantal"
End With
With wsV
    .Range("H1").Value = "Datum Besteld"
End With
    
    For i = 2 To wsV.UsedRange.Rows.Count
    ' extract items where stock is at or below minimum, a maximum exists, and the item isn't already on order
    If wsV.Range("F" & i).Value <= wsV.Range("B" & i).Value And wsV.Range("C" & i).Value <> "" And wsV.Range("G" & i).Value <> 0 Then
        wsV.Range("G" & i).Value = wsV.Range("B" & i).Value - wsV.Range("F" & i).Value
        ' write out the order
        j = j + 1
        wsB.Range("A" & j).Value = wsV.Range("A" & i).Value
        wsB.Range("B" & j).Value = wsV.Range("G" & i).Value
        wsV.Range("H" & j).Value = Format(dd - mm - yyyy, Date)
    End If
Next i
' preview the order
wsB.PrintPreview
End Sub
 
Upvote 0 Downvote
Hi pookie62,

The code assumes that the 1st row on your Voorraad sheet is a header row, not a data row. If it's a data row, simply change:
For i = 2 To wsV.UsedRange.Rows.Count
to
For i = 2 To wsV.UsedRange.Rows.Count

You date code is using the wrong reference for outputting the date! Change:
wsV.Range("H" & j).Value = Format(dd - mm - yyyy, Date)
to
wsV.Range("H" & i).Value = Format(dd - mm - yyyy, Date)

Cheers
PS: By the way, do you ever have a situation where the maximum & minumum are the same? (hopefully it's never less ...) If so, the code will need to be changed to prevent nil orders being placed where the stock on hand matches the maximum/minimum.
 
Upvote 0 Downvote
Hi macropod,
Sorry to bother but there must be a typo ?
Code: 
For i = 2 To wsV.UsedRange.Rows.Count
to
For i = 2 To wsV.UsedRange.Rows.Count
 
Upvote 0 Downvote
Oops, submitted too soon..
The first row on the voorrraad sheet is indeed a header row.
But it's not processed... ?
Your PS question : I'm not sure (I'm helping out a friend for his work..) but I assume the max and min are not the same.. If so, I can always come back to it in a new post.
Thanks for thinking with me though !
 
Upvote 0 Downvote
Typo indeed - I meant to say to change:
For i = 2 To wsV.UsedRange.Rows.Count
to
For i = 1 To wsV.UsedRange.Rows.Count

However, if it's a header row, you wouldn't want to do that.

By the way, I also noticed that you've added:
With wsV
.Range("H1").Value = "Datum Besteld"
End With
This seems overkill - surely you don't need to overwrite cell H1 on the Voorraad sheet every time? In any event, the with/end with is unnecessary here and could be replaced with:
wsV.Range("H1").Value = "Datum Besteld"

One other thing - the code:
Format(dd - mm - yyyy, Date)
has the wrong syntax. It should be:
Format(Date, "dd - mm - yyyy")

Cheers
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Andrzejek
  • Locked
  • Question
Open Word as ReadOnly 1
Replies
6
Views
686
Chriss Miller
C
Andrzejek
  • Locked
  • Question
Hyperlinks in Word cut at #
Replies
2
Views
444
Andrzejek
Andrzejek
remeng
  • Locked
  • Solved
Run-time error '429': ActiveX component can't create object From Excel to Word
Replies
9
Views
2K
remeng
remeng
remeng
  • Locked
  • Solved
Combine two working macros into one for MS Word 1
Replies
7
Views
1K
strongm
strongm
remeng
  • Locked
  • Helpful tip
Microsoft Office 365 Word Macro Causing a Project is unviewable error
Replies
1
Views
1K
dhookom
dhookom

Part and Inventory Search

Sponsor

Back
Top