Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Automatic copy, paste and save as PDF for a range of numbers

1

Hi everyone. Greetings from Venezuela

I'm doing some (kinda) work at home for some friends. That .xlsx have a sheet where shows some info after you put an ID that will be printed with a nice format and another sheet where all the info are. I used the VLOOKUP to show that in the first page. 

Everything works fine, but to complete the task like they want, the .xlsx have to actually print every single registry. I'm not VBA savvy but I think this is the kind of work is made for.

I tried to record a macro where I first clear the space where the ID goes, then go to the sheet where all the IDs are and copy the first one, then paste it in the first sheet to get the info of that particular one, then save it as a PDF document...

Then, I get stuck.

How can I actually use Excel to be able to continue that task, repeating it over and over again for every single ID to save them as PDFs (or one PDF with multiple pages. That would be awesome if possible) and stop when the code reach the end of the list (without making a computer meltdown in the process)?

Thank you first of all!

Answer
Discuss

Discussion

You can use 'SaveAs' and select PDF format. The same thing can be done using VBA. Therefore the real challenge is to do this in a controlled loop and change the ID before each Save. VBA can do that too. However, the information you have provided is very far from sufficient. I suggest you post a workbook with precise information.
Variatus (rep: 4889) Jan 14, '18 at 3:54 am
Thanks for the answer

Ok, I don't know exactly how to explain that but, maybe the VBA recorded can be helpful (I think):

Sub Test()
'
' Test Macro
'
 
'
    Range("F14").Select
    Selection.ClearContents
    Sheets("Datos").Select
    Range("A2").Select
    Selection.Copy
    Sheets("Planilla").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\laczp\Desktop\1.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
End Sub


And after that, over all the length of the A column until it reaches the end. That is the tricky bit. I don't know (I'm not really good at) programming even though I studied computer science, but I'm trying to understand how to apply a cycle with a counter to do that everytime till the end.

The other tricky part is the PDF itself. If you notice, I saved the PDF with the name "1.pdf", but if I do a cycle is possible to rewrite again and again the same file. So, a dead end. Is it possible to take that first value and use it to rename the file at the end of every cycle?
laczpro19 (rep: 4) Jan 14, '18 at 2:18 pm
Add to Discussion

Answers

1
Selected Answer

OK. Please try this code - Version 2.
The code now shows its progress in the Status bar (left bottom of your screen) and gives a final report when it is done.

Sub CreateAllPDFs()
    ' 14 Jan 2018 - Vers 2
    
    Const NameCell As String = "F14"            ' this cell is on WsPlan
    
    Dim WsData As Worksheet                     ' list of names
    Dim WsPlan As Worksheet                     ' worksheet to be saved
    Dim Rl As Long                              ' last used row (WsData)
    Dim R As Long                               ' row counter (WsData)
    Dim Addressee As String
    Dim CountDown As Integer
    
    With ThisWorkbook
        Set WsData = .Worksheets("Datos")
        Set WsPlan = .Worksheets("Planilla")
    End With
    
    With WsData
        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
        CountDown = Rl - 1
        For R = 2 To Rl                         ' count from 2 to Rl
            Addressee = WsPlan.Range(NameCell).Value = .Cells(R, "A").Value
            Application.StatusBar = "Processing " & Addressee & " (" & R - 1 & _
                                    " of " & Rl - 1 & " - " & CountDown & " remaing)"
            If Not CreateOnePDF(WsPlan, Addressee, R - 1) Then
                If MsgBox("An exception occurred while trying to create" & vbCr & _
                          "the PDF for " & Addressee & vbCr & _
                          "Do you want to continue with the next file?", _
                           vbYesNo Or vbQuestion, "Couldn't create PDF") <> vbYes Then _
                Exit For
            Else
                CountDown = CountDown - 1
            End If
        Next R
    End With
    
    If R > Rl Then MsgBox Rl - 2 & " files were processed." & vbCr & _
                          CountDown & " files were skipped.", _
                          vbOKOnly, "End of program"
    Application.StatusBar = ""
End Sub
Private Function CreateOnePDF(WsPlan As Worksheet, _
                              ByVal Addressee As String, _
                              ByVal Count As Long) As Boolean
    ' 14 Jan 2018 - Vers 2
   
    ' Pathname must end with a backslash
    Const PathName As String = "C:\Users\laczp\Desktop\"
   
    Dim Fun As Boolean                          ' function return value
    Dim Ffn As String                           ' Full file name
    Dim TimeOut As Double
   
    ' modify the file name here:
    Ffn = Trim(Addressee) & "-" & CStr(Count)
    Ffn = PathName & Ffn & ".pdf"
   
    ' files by the same names already existing in the taret directory
    ' will be over-written without warning
    On Error Resume Next
    WsPlan.ExportAsFixedFormat Type:=xlTypePDF, _
                               Filename:=Ffn, _
                               Quality:=xlQualityStandard, _
                               IncludeDocProperties:=True, _
                               IgnorePrintAreas:=False, _
                               OpenAfterPublish:=False
    Fun = Not CBool(Err)
   
    ' the following is to let VBA wait for the file
    ' to be written to disc (disc is much slower than VBA)
    If Fun Then
        TimeOut = Time + (3 / 24 / 60 / 60)         ' 3 seconds wait time
        Do While Len(Dir(Ffn)) = 0
            DoEvents
            If Time > TimeOut Then
                MsgBox "System timed out while creating" & vbCr & _
                        Ffn, vbOKOnly, "System is slow"
                ' if the file gets created while the MsgBox is shown
                ' consider increasing the TimeOut wait time
                Fun = False
                Exit Do
            End If
        Loop
    End If
   
    CreateOnePDF = Fun
End Function

I didn't test all the possible error conditions. If they ever occur and if they let you wonder why the macro reacts in a certain way which seems opposite to what you would expect just bear with me. It's a frequent programming error to confuse yes and no, 0 and 1, True and False. Just consider reversing the logic that offends you, lol:

Discuss

Discussion

OH MY GOD! You're amazing! (and YES, I'm yelling it)

Right now is doing the 109 of 280 pages without major issues (some corrections to do to the data), and now the code is completely on tracks.

It isn't fast, but is doing the job like is meant to. Thank you so much!
laczpro19 (rep: 4) Jan 14, '18 at 9:41 pm
I'm glad this worked so well. Truth be told, you did provide good guidance. However, since you have 280 files to do an indicator of the progress should be useful as well as a notice when no more action is to be expected. I have added both to the second version of the code now displayed above.
Variatus (rep: 4889) Jan 14, '18 at 10:16 pm
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login