Auto or one click Word doc macro to run 3 different reports

K

kokapellie1

New Member
Joined
May 24, 2019
Messages
4
Hi All,
I normally would not come here, but sadly am now at the deadline and running this as it is does not work. I am trying to get this to auto run on open or just click the Get Report button once to run all three reports f possible.

Code: 
[Private Sub CboReportName_Change()

End Sub
Private Sub Document_Open()
    CboReportName.AddItem "Report E"
    CboReportName.AddItem "Report F"
    CboReportName.AddItem "Report G"
End Sub
Private Sub GetReport_Click()
Dim rgePages As Range
Dim oRng As Word.Range
SavePath = "[URL="file://\\nfpgshare-1.edwardjones.com\export\insurance_annuity_operations\Insurance_Operations\Internal_Operational_Reports\Insurance_Operations_Team\Daily_Transmittals"]XXXXXXX\Daily_Transmittals[/URL]"
'SavePath = "C:\Temp\Mark"
  
Application.ScreenUpdating = False
Select Case CboReportName
    Case "Report E"
        ReportToOpen = "INS050E.txt"
        ReportTrailer = "Life"
    Case "Report F"
        ReportToOpen = "INS050F.txt"
        ReportTrailer = "Disability"
    Case "Report G"
        ReportToOpen = "INS050G.txt"
        ReportTrailer = "LTC"
End Select
Documents.Open FileName:="XXXXXXXX" & ReportToOpen
'Documents.Open FileName:="C:\Temp\Mark" & ReportToOpen
        
        
    With ActiveDocument.Styles(wdStyleNormal).Font
        If .NameFarEast = .NameAscii Then
            .NameAscii = ""
        End If
        .NameFarEast = ""
    End With
    
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientLandscape
        .TopMargin = InchesToPoints(0.92)
        .BottomMargin = InchesToPoints(0.92)
        .LeftMargin = InchesToPoints(1)
        .RightMargin = InchesToPoints(1)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.5)
        .FooterDistance = InchesToPoints(0.5)
        .PageWidth = InchesToPoints(11)
        .PageHeight = InchesToPoints(8.5)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
        .LayoutMode = wdLayoutModeDefault
    End With
    Selection.WholeStory
    Selection.Font.Size = 8
    Selection.MoveUp unit:=wdLine, Count:=1
    
    
    'insert breaks 5/25/2018
    Selection.EndKey unit:=wdStory
    With ActiveDocument.Content.Find
    Do While .Execute(FindText:="1RUN", Forward:=False, _
                Format:=True) = True
            With .Parent
            .Select
            .StartOf unit:=wdParagraph
            .Collapse Direction:=wdCollapseEnd
            .InsertBreak (wdPageBreak)
            'Selection.MoveDown unit:=wdpage, Count:=1
            End With
        Loop
        End With
 '*****************************
        
 ActiveDocument.Repaginate
j = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
For i = j To 1 Step -1
    NotEmpty = True
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=CStr(i)
    Selection.GoTo What:=wdGoToBookmark, Name:="\page"
    If Selection.Characters.Count < 3 Then
        NotEmpty = False
        For Each c In Selection.Characters
            If Asc(c) > 13 Then
                ''Possibly not empty
                NotEmpty = True
            End If
        Next
    End If
    If NotEmpty = False Then
        Selection.Delete
    End If
Next
        
        
        
    '*************************************
        
        
        
        
        
        
    'highlight DEEBIT: Y
    'go to beginning
    Selection.HomeKey unit:=wdStory
    
    With ActiveDocument.Content.Find
    .ClearFormatting
    
        Do While .Execute(FindText:="DEBIT: Y", Forward:=True, _
                Format:=True) = True
            With .Parent
                .HighlightColorIndex = wdYellow
            End With
        Loop
    End With


Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1"
'remove empty lines from the beginning of the report
Do
  
    Selection.EndKey unit:=wdLine, Extend:=wdExtend
    If Len(Selection) > 2 Then Exit Do
    Selection.Delete
  
Loop
'remove end of report lines
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = ">>"
While .Execute
oRng.Paragraphs(1).Range.Delete
Wend
End With

ActiveDocument.Repaginate
TotalPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)

Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1"
Selection.MoveDown unit:=wdLine, Count:=3
    Selection.MoveRight unit:=wdCharacter, Count:=40, Extend:=wdExtend
    StartPage = Selection.Information(wdActiveEndPageNumber)
    Vendor1 = Trim(Selection.Text)
    
For i = 1 To TotalPages
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=i
    'verify the first word is RUN otherwise goto next page
    Selection.MoveRight unit:=wdWord, Count:=1, Extend:=wdExtend
        PageVerify = Selection.Text
    Selection.MoveLeft unit:=wdWord, Count:=1, Extend:=wdExtend
    If PageVerify = "1RUN" Then
    
    Selection.MoveDown unit:=wdLine, Count:=3
    Selection.MoveRight unit:=wdCharacter, Count:=40, Extend:=wdExtend
    Vendor2 = Trim(Selection.Text)
        If Vendor1 <> Vendor2 Or i = TotalPages Then
            If i = TotalPages Then
                EndPage = i
            Else
                EndPage = i - 1
            End If
            Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=StartPage
            Set rgePages = Selection.Range
            Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=EndPage
            rgePages.End = Selection.Bookmarks("\Page").Range.End
               rgePages.Select
               rgePages.Copy
            
             Set docNew = Application.Documents.Add
             docNew.Bookmarks("\EndOfDoc").Range.Paste
             
             'format new document the same as the main document
             With ActiveDocument.PageSetup
                .LineNumbering.Active = False
                .Orientation = wdOrientLandscape
                .TopMargin = InchesToPoints(0.92)
                .BottomMargin = InchesToPoints(0.92)
                .LeftMargin = InchesToPoints(1)
                .RightMargin = InchesToPoints(1)
                .Gutter = InchesToPoints(0)
                .HeaderDistance = InchesToPoints(0.5)
                .FooterDistance = InchesToPoints(0.5)
                .PageWidth = InchesToPoints(11)
                .PageHeight = InchesToPoints(8.5)
                .FirstPageTray = wdPrinterDefaultBin
                .OtherPagesTray = wdPrinterDefaultBin
                .SectionStart = wdSectionNewPage
                .OddAndEvenPagesHeaderFooter = False
                .DifferentFirstPageHeaderFooter = False
                .VerticalAlignment = wdAlignVerticalTop
                .SuppressEndnotes = False
                .MirrorMargins = False
                .TwoPagesOnOne = False
                .BookFoldPrinting = False
                .BookFoldRevPrinting = False
                .BookFoldPrintingSheets = 1
                .GutterPos = wdGutterPosLeft
                .LayoutMode = wdLayoutModeDefault
            End With
            
    Selection.WholeStory
    Selection.Font.Size = 8
    Selection.MoveUp unit:=wdLine, Count:=1
    Selection.HomeKey unit:=wdStory
                         
  'insert divider
        With ActiveDocument.Content.Find
            .ClearFormatting
            
            Do While .Execute(FindText:="TOTAL NEW PURCHASE", Forward:=True, _
                    Format:=True) = True
                With .Parent
                     .Select
                      Selection.MoveDown unit:=wdLine, Count:=1
                    'Selection.TypeParagraph
                    Selection.Font.Size = 24
                    Selection.Font.Bold = True
                    Selection.Font.Color = wdColorRed
                    Selection.TypeText Text:= _
                     "____________________________________________"
                    Selection.TypeParagraph
                End With
            Loop
        End With
                       
              If Vendor1 = "" Then GoTo NoSave
             docNew.SaveAs SavePath & "" & Vendor1 & " " & ReportTrailer
NoSave:
             docNew.Close False
            
            StartPage = i
            Vendor1 = Vendor2
        End If
    End If
Next i



Application.ScreenUpdating = True
Documents(ReportToOpen).Close False
End Sub
]

Any help would be greatly appreciated!!
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
Your Document_Open code never initialises your UserForm, which it should do before any of the CboReportName.AddItem lines.
 
Upvote 0
Macropod said:
Your Document_Open code never initialises your UserForm, which it should do before any of the CboReportName.AddItem lines.
Click to expand...

Ok so i added a

Private Sub UserForm_Initialize()

End sub

Not sure how that would help me run all the reports with one click.
 
Upvote 0
Of itself, that doesn't initialise your UserForm, whether when you open the document, or otherwise. You need to at least have a line of code like:
UserForm1.Show
in either your UserForm_Initialize sub (if you want to be able to run the userform manually), which you'd then call from your Document_Open sub, or as the first line in your Document_Open sub.
 
Upvote 0
OK I think have it se like you asked:

Code: 
Private Sub UserForm_Initialize()
UserForm1.Show
End Sub
Private Sub CboReportName_Change()

End Sub
Private Sub Document_Open()
UserForm1.UserForm_Initialize
    CboReportName.AddItem "Report E"
    CboReportName.AddItem "Report F"
    CboReportName.AddItem "Report G"
End Sub
Private Sub GetReport_Click()
Dim rgePages As Range
Dim oRng As Word.Range
SavePath = "[URL="file://\\nfpgshare-1.edwardjones.com\export\insurance_annuity_operations\Insurance_Operations\Internal_Operational_Reports\Insurance_Operations_Team\Daily_Transmittals"]\\nfpgshare-1.edwardjones.com\export\insurance_annuity_operations\Insurance_Operations\Internal_Operational_Reports\Insurance_Operations_Team\Daily_Transmittals[/URL]"
'SavePath = "C:\Temp\Mark"
  
Application.ScreenUpdating = False
Select Case CboReportName
    Case "Report E"
        ReportToOpen = "INS050E.txt"
        ReportTrailer = "Life"
    Case "Report F"
        ReportToOpen = "INS050F.txt"
        ReportTrailer = "Disability"
    Case "Report G"
        ReportToOpen = "INS050G.txt"
        ReportTrailer = "LTC"
End Select
Documents.Open FileName:="X:\insurance_annuity_operations\Processing_Team_Information\Life_Team_Information\Daily_transmittal" & ReportToOpen
'Documents.Open FileName:="C:\Temp\Mark" & ReportToOpen
        
        
    With ActiveDocument.Styles(wdStyleNormal).Font
        If .NameFarEast = .NameAscii Then
            .NameAscii = ""
        End If
        .NameFarEast = ""
    End With
    
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientLandscape
        .TopMargin = InchesToPoints(0.92)
        .BottomMargin = InchesToPoints(0.92)
        .LeftMargin = InchesToPoints(1)
        .RightMargin = InchesToPoints(1)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.5)
        .FooterDistance = InchesToPoints(0.5)
        .PageWidth = InchesToPoints(11)
        .PageHeight = InchesToPoints(8.5)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
        .LayoutMode = wdLayoutModeDefault
    End With
    Selection.WholeStory
    Selection.Font.Size = 8
    Selection.MoveUp unit:=wdLine, Count:=1
    
    
    'insert breaks 5/25/2018
    Selection.EndKey unit:=wdStory
    With ActiveDocument.Content.Find
    Do While .Execute(FindText:="1RUN", Forward:=False, _
                Format:=True) = True
            With .Parent
            .Select
            .StartOf unit:=wdParagraph
            .Collapse Direction:=wdCollapseEnd
            .InsertBreak (wdPageBreak)
            'Selection.MoveDown unit:=wdpage, Count:=1
            End With
        Loop
        End With
 '*****************************
        
 ActiveDocument.Repaginate
j = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
For i = j To 1 Step -1
    NotEmpty = True
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=CStr(i)
    Selection.GoTo What:=wdGoToBookmark, Name:="\page"
    If Selection.Characters.Count < 3 Then
        NotEmpty = False
        For Each c In Selection.Characters
            If Asc(c) > 13 Then
                ''Possibly not empty
                NotEmpty = True
            End If
        Next
    End If
    If NotEmpty = False Then
        Selection.Delete
    End If
Next
        
        
        
    '*************************************
        
        
        
        
        
        
    'highlight DEEBIT: Y
    'go to beginning
    Selection.HomeKey unit:=wdStory
    
    With ActiveDocument.Content.Find
    .ClearFormatting
    
        Do While .Execute(FindText:="DEBIT: Y", Forward:=True, _
                Format:=True) = True
            With .Parent
                .HighlightColorIndex = wdYellow
            End With
        Loop
    End With


Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1"
'remove empty lines from the beginning of the report
Do
  
    Selection.EndKey unit:=wdLine, Extend:=wdExtend
    If Len(Selection) > 2 Then Exit Do
    Selection.Delete
  
Loop
'remove end of report lines
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = ">>"
While .Execute
oRng.Paragraphs(1).Range.Delete
Wend
End With

ActiveDocument.Repaginate
TotalPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)

Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1"
Selection.MoveDown unit:=wdLine, Count:=3
    Selection.MoveRight unit:=wdCharacter, Count:=40, Extend:=wdExtend
    StartPage = Selection.Information(wdActiveEndPageNumber)
    Vendor1 = Trim(Selection.Text)
    
For i = 1 To TotalPages
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=i
    'verify the first word is RUN otherwise goto next page
    Selection.MoveRight unit:=wdWord, Count:=1, Extend:=wdExtend
        PageVerify = Selection.Text
    Selection.MoveLeft unit:=wdWord, Count:=1, Extend:=wdExtend
    If PageVerify = "1RUN" Then
    
    Selection.MoveDown unit:=wdLine, Count:=3
    Selection.MoveRight unit:=wdCharacter, Count:=40, Extend:=wdExtend
    Vendor2 = Trim(Selection.Text)
        If Vendor1 <> Vendor2 Or i = TotalPages Then
            If i = TotalPages Then
                EndPage = i
            Else
                EndPage = i - 1
            End If
            Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=StartPage
            Set rgePages = Selection.Range
            Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=EndPage
            rgePages.End = Selection.Bookmarks("\Page").Range.End
               rgePages.Select
               rgePages.Copy
            
             Set docNew = Application.Documents.Add
             docNew.Bookmarks("\EndOfDoc").Range.Paste
             
             'format new document the same as the main document
             With ActiveDocument.PageSetup
                .LineNumbering.Active = False
                .Orientation = wdOrientLandscape
                .TopMargin = InchesToPoints(0.92)
                .BottomMargin = InchesToPoints(0.92)
                .LeftMargin = InchesToPoints(1)
                .RightMargin = InchesToPoints(1)
                .Gutter = InchesToPoints(0)
                .HeaderDistance = InchesToPoints(0.5)
                .FooterDistance = InchesToPoints(0.5)
                .PageWidth = InchesToPoints(11)
                .PageHeight = InchesToPoints(8.5)
                .FirstPageTray = wdPrinterDefaultBin
                .OtherPagesTray = wdPrinterDefaultBin
                .SectionStart = wdSectionNewPage
                .OddAndEvenPagesHeaderFooter = False
                .DifferentFirstPageHeaderFooter = False
                .VerticalAlignment = wdAlignVerticalTop
                .SuppressEndnotes = False
                .MirrorMargins = False
                .TwoPagesOnOne = False
                .BookFoldPrinting = False
                .BookFoldRevPrinting = False
                .BookFoldPrintingSheets = 1
                .GutterPos = wdGutterPosLeft
                .LayoutMode = wdLayoutModeDefault
            End With
            
    Selection.WholeStory
    Selection.Font.Size = 8
    Selection.MoveUp unit:=wdLine, Count:=1
    Selection.HomeKey unit:=wdStory
                         
  'insert divider
        With ActiveDocument.Content.Find
            .ClearFormatting
            
            Do While .Execute(FindText:="TOTAL NEW PURCHASE", Forward:=True, _
                    Format:=True) = True
                With .Parent
                     .Select
                      Selection.MoveDown unit:=wdLine, Count:=1
                    'Selection.TypeParagraph
                    Selection.Font.Size = 24
                    Selection.Font.Bold = True
                    Selection.Font.Color = wdColorRed
                    Selection.TypeText Text:= _
                     "____________________________________________"
                    Selection.TypeParagraph
                End With
            Loop
        End With
                       
              If Vendor1 = "" Then GoTo NoSave
             docNew.SaveAs SavePath & "" & Vendor1 & " " & ReportTrailer
NoSave:
             docNew.Close False
            
            StartPage = i
            Vendor1 = Vendor2
        End If
    End If
Next i



Application.ScreenUpdating = True
Documents(ReportToOpen).Close False
End Sub
 
Upvote 0
You can delete this tread I am going to need to find a different way to accomplish this sdl.. :( But thank you for your help...
 
Upvote 0
As I said, you need to have a line like:
UserForm1.Show
or a call to UserForm_Initialize in your Document_Open sub. Your line:
UserForm1.UserForm_Initialize
is not what I said you need. A call to UserForm_Initialize would be coded as:
Call UserForm_Initialize
and, in that case, your UserForm_Initialize sub would need the line:
UserForm1.Show
Obviously, then, having UserForm1.Show in your Document_Open sub is the simpler approach.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Copy an excel table and paste it into word
Replies
2
Views
957
Paskie_EU
P
N
  • Question Question
VBScript for locating the current day's email for a specific file...
Replies
0
Views
1K
netwerkz
N
D
  • Question Question
Re: MS Word Macro for Find & Export to Excel
Replies
6
Views
2K
danielbasilio
D
P
  • Question Question
MS Word 2010 Copy Paste
Replies
0
Views
618
Papi
P
B
  • Question Question
Really need help. over 20 hours spent and almost complete - WORD macro
Replies
3
Views
1K
Macropod
Macropod

Forum statistics

Threads
1,223,246
Messages
6,170,987
Members
452,373
Latest member
TimReeks

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top