maghari
05-18-2020, 12:47 PM
hi,
this my code really works i would tweak to make it specific sheets save as pdf and print out for instance i have 10 sheets then i would save as pdf only (sheet1,sheet5,sheet8) and print out them i try with this line but it doesn't work i have no experience for vba
ThisWorkbook.Worksheets(Array("1", "2", "3")).PrintOut
this is my code
Sub pdfcopy()
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = False
Application.EnableEvents = False
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim lOver As Long
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strPath = ThisWorkbook.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"'
For i = 1 To Sheets.Count
If i <> "" Then
strName = i & "-salim-" & ActiveSheet.Range("b3").Value
strFile = strName & ".pdf"
strPathFile = strPath & strFile
If bFileExists(strPathFile) Then
lOver = MsgBox("the file is existed do you replaced it ?", _
vbQuestion + vbYesNo, "file is existed ")
If lOver <> vbYes Then
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="choose place of save ")
If myFile <> "False" Then
strPathFile = myFile
Else GoTo exitHandler
End If
End If
End If
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If'
Next i
MsgBox "folder is created: " & vbCrLf & strPathFile
errHandler: Resume exitHandler
exitHandler:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub'=============================
Function bFileExists(rsFullPath As String) As Boolean
bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function
this my code really works i would tweak to make it specific sheets save as pdf and print out for instance i have 10 sheets then i would save as pdf only (sheet1,sheet5,sheet8) and print out them i try with this line but it doesn't work i have no experience for vba
ThisWorkbook.Worksheets(Array("1", "2", "3")).PrintOut
this is my code
Sub pdfcopy()
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = False
Application.EnableEvents = False
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim lOver As Long
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strPath = ThisWorkbook.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"'
For i = 1 To Sheets.Count
If i <> "" Then
strName = i & "-salim-" & ActiveSheet.Range("b3").Value
strFile = strName & ".pdf"
strPathFile = strPath & strFile
If bFileExists(strPathFile) Then
lOver = MsgBox("the file is existed do you replaced it ?", _
vbQuestion + vbYesNo, "file is existed ")
If lOver <> vbYes Then
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="choose place of save ")
If myFile <> "False" Then
strPathFile = myFile
Else GoTo exitHandler
End If
End If
End If
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If'
Next i
MsgBox "folder is created: " & vbCrLf & strPathFile
errHandler: Resume exitHandler
exitHandler:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub'=============================
Function bFileExists(rsFullPath As String) As Boolean
bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function