Automate Print Code to PDF?

[klarowe]

With Excel 2003 I was able to right click on a workbook in the VBA editor and select print, then select my PDF Printer (Primo PDF) and it would save the codes to PDF.

Now with Excel2010 I know there is an easier way to save to PDF for the actual workbook, but what about for the codes? And can it be automated?

 

[klarowe]

Thank you for that, it worked perfectly. Its not quite what I was hoping for but it should work fine. The only thing I didn't like about it is that by doing it manually it nicely separates everything out (each module / sheet to its own page). But I think if I can work the font a little bit with what you posted it might work out ok. Right now its just such a larger font (probably 12 or so) that it seems to take up a lot more pages than it really needs.

But either way, it is a lot closer than I was before so thank you!!!

 

[klarowe]

I almost have it perfect. Right now I have it formatted just about the way I want it using this final code:

Sub SaveCodesToPDF()
    Dim wb As Workbook
    Dim WordApp As Word.Application
    Dim TempDoc As Word.DOCUMENT
    Dim VBP As VBIDE.VBProject
    Dim VBC As VBIDE.VBComponent
    Dim Data As String
    Dim LineCount As Long
    
    For Each wb In Workbooks
        On Error Resume Next
        Set VBP = ActiveWorkbook.VBProject
        On Error GoTo 0
    
        If VBP Is Nothing Then
            MsgBox "Your security settings do not allow this macro to run."
            Exit Sub
        End If
    
        CDR = Replace(wb.Name, ".xlsm", "")
        oName = CDR & " Codes"
    
        Set WordApp = CreateObject("Word.Application")
        Set TempDoc = WordApp.DOCUMENTS.Add
    
        Data = ""
        For Each VBC In VBP.VBComponents
            With VBC.CodeModule
                LineCount = .CountOfLines - .CountOfDeclarationLines
            End With
            If LineCount > 0 Then
                With VBC.CodeModule
                    Data = WorksheetFunction.Rept("=", 60) & vbCrLf
                    Data = Data & "VB Component: " & VBC.Name & vbCrLf
                    Data = Data & .Lines(1, .CountOfLines) & vbCrLf
                End With
                TempDoc.Content.InsertAfter Data
                Data = ""
            End If
        Next VBC
    
        With TempDoc.Content.Font
            .Name = "Times New Roman"
            .Bold = False
            .Size = 8
        End With
    
        With TempDoc.Content.PageSetup
            .TopMargin = InchesToPoints(0.5)
            .BottomMargin = InchesToPoints(0.5)
            .LeftMargin = InchesToPoints(0.5)
            .RightMargin = InchesToPoints(0.5)
        End With
    
        With TempDoc.Content.ParagraphFormat
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 0
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceSingle
        End With
    
        TempDoc.ExportAsFixedFormat "S:\SERVICE\Repair Shop CDRs\CDR Templates\CDR Codes Test\" & oName & ".pdf", wdExportFormatPDF
        'TempDoc.SaveAs "S:\SERVICE\Repair Shop CDRs\CDR Templates\CDR Codes Test\" & oName
        TempDoc.Close savechanges:=False
        WordApp.Quit
    Next wb
End Sub

Now if I could just find a way to tell it to find the "============" text that exists between each module / sheet and have it insert a page break before each occurance of that text (but skipping the first occurance so there is not a blank page at the beginning) it would be 100% perfect.

I found this code that can run in Microsoft office and inserts the page break (does not skip the first occurance though so I still get the blank page). But I cannot figure out how to incorporate it into the main code so that it runs all together.

Dim r As Range
    Set r = ActiveDocument.Range
    With r.Find
        Do While .Execute(FindText:="==============", _
            Forward:=True) = True
            r.InsertBefore (Chr(12))
            r.Collapse 0
        Loop
    End With

All of your help is greatly appreciated!!!

 

[klarowe]

Missed the edit, but I managed to figure out a workaround for removing the empty space in the beginning of the document (when the "page break" is inserted before the very first "========" instance). Now I just need to incorporate this into the main code

Sub test()
    Dim r As Range
    Set r = ActiveDocument.Range
    With r.Find
        Do While .Execute(FindText:="============================================================", _
            Forward:=True) = True
            r.InsertBefore (Chr(12))
            r.Collapse 0
        Loop
    End With
    Selection.HomeKey Unit:=wdStory
    Selection.Delete Unit:=wdCharacter, Count:=1
End Sub

 

[Domenic]

Try...

Option Explicit

Sub test()

    Dim WordApp As Word.Application
    Dim TempDoc As Word.Document
    
    Dim VBP As VBIDE.VBProject
    Dim VBC As VBIDE.VBComponent
    
    Dim Data As String
    Dim LineCount As Long
    Dim VBCompCount As Long
    Dim i As Long
    
    On Error Resume Next
    Set VBP = ActiveWorkbook.VBProject
    On Error GoTo 0
    
    If VBP Is Nothing Then
        MsgBox "Your security settings do not allow this macro to run."
        Exit Sub
    End If
    
    Set WordApp = CreateObject("Word.Application")
    
    Set TempDoc = WordApp.Documents.Add
    
    VBCompCount = VBP.VBComponents.Count
    
    Data = ""
    For i = 1 To VBCompCount
        With VBP.VBComponents(i).CodeModule
            LineCount = .CountOfLines - .CountOfDeclarationLines
        End With
        If LineCount > 0 Then
            With VBP.VBComponents(i).CodeModule
                Data = Data & "VB Component: " & VBP.VBComponents(i).Name & vbCrLf & vbCrLf
                Data = Data & .Lines(1, .CountOfLines) & vbCrLf
            End With
            TempDoc.Content.InsertAfter Data
            If i <> VBCompCount Then
                With TempDoc.Range
                    .Collapse Direction:=wdCollapseEnd
                    .InsertBreak Type:=wdPageBreak
                End With
            End If
            Data = ""
        End If
    Next i
    
    With TempDoc.Content.Font
        .Name = "Times New Roman"
        .Bold = False
        .Size = 8
    End With

    With TempDoc.Content.PageSetup
        .TopMargin = InchesToPoints(0.5)
        .BottomMargin = InchesToPoints(0.5)
        .LeftMargin = InchesToPoints(0.5)
        .RightMargin = InchesToPoints(0.5)
    End With

    With TempDoc.Content.ParagraphFormat
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
    End With
            
'   Change the path/filename accordingly
    TempDoc.ExportAsFixedFormat "C:\Users\Domenic\Desktop\sample123.pdf", wdExportFormatPDF
    
    TempDoc.Close savechanges:=False
    
    WordApp.Quit
    
End Sub

Change/amend the code, as necessary.

 

[klarowe]

Initial testing shows it to be working great!!! Thanks

Now I just have one more thing to add if you don't mind. For VB projects that are protected, is it possible to unprotect it, run the code, then re-protect it (similar to a protected sheet)?

 

[klarowe]

As a note, this is for my own workbook and I know the password. I also know that the only real way to do it is a "workaround" using SendKeys which I am ok with. I am the only person who will be using this code so if it fails once in a while it won't bother me. Basically I just need to know how to get the VB password window to open so I can use the Sendkeys to enter the password.
Thanks.

 

[Domenic]

Initial testing shows it to be working great!!! Thanks

You're very welcome! Thanks for the feedback!

Now I just have one more thing to add if you don't mind. For VB projects that are protected, is it possible to unprotect it, run the code, then re-protect it (similar to a protected sheet)?

I haven't tried it myself, but see if this helps...

http://www.ozgrid.com/forum/showthread.php?t=13006