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: