首页 > 解决方案 > 如果不存在,则创建文件夹,使用 VBA 在 Windows 操作系统中有效,但在 MAC 操作系统中无效

问题描述

我需要从以下代码中的 Excel 工作表“模块”中导出 PDF:

链接在这里: https ://drive.google.com/file/d/1H1os30Tn03x_q8HxLWBy_pZpxh_Rs7Gk/view?usp=sharing

Sub FillForm()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Desiredrow = InputBox("Immettere il numero della prima riga per la quale si desidera creare il pdf", "Numero di riga?")
Endrowno = InputBox("Immettere il numero dell'ultima riga per la quale si desidera creare il pdf", "Numero di riga?")
If IsNumeric(Desiredrow) = True And IsNumeric(Endrowno) = True Then
    For i = Desiredrow To Endrowno
        ThisWorkbook.Worksheets("modulo").Range("C10") = Date
        ThisWorkbook.Worksheets("modulo").Range("D11") = ThisWorkbook.Worksheets("database").Range("G" & i)
        ThisWorkbook.Worksheets("modulo").Range("C12") = ThisWorkbook.Worksheets("database").Range("H" & i) & " a " & ThisWorkbook.Worksheets("database").Range("J" & i)
        ThisWorkbook.Worksheets("modulo").Range("D13") = ThisWorkbook.Worksheets("database").Range("V" & i) & " , " & ThisWorkbook.Worksheets("database").Range("T" & i)
        Call GeneratePDF
    Next i
    MsgBox "pdf generato con successo"
Else
MsgBox "il numero di riga deve essere un valore numerico"
End If
ThisWorkbook.Worksheets("database").Activate
Application.DisplayAlerts = False
Application.ScreenUpdating = True

End Sub

上面的代码将在获取起始行数和结束行数后调用 GeneratePDF。

Sub GeneratePDF()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim VelleName As String
Dim SelectedRange As Range
With ThisWorkbook.Worksheets("modulo")
.Activate
.Range(.Cells(1, 1), .Cells(33, 10)).Select
Selection.Name = "SelectedRange"
End With


On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveWorkbook.Worksheets("modulo")
strTime = Format(Now(), "ddmmyyyy\_hhmmss")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & Application.PathSeparator


VelleName = ThisWorkbook.Worksheets("database").Range("E" & i) & ThisWorkbook.Worksheets("database").Range("B" & i) & "_" & ThisWorkbook.Worksheets("database").Range("C" & i)

'replace spaces and periods in sheet name
strName = Replace(VelleName, " ", "_")
strName = Replace(strName, ".", "_")
strName = Replace(strName, "-", "_")
strName = Replace(strName, "/", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"

strPathFile = strName & "_" & strTime


'select folder for file
If Dir(strPath & Application.PathSeparator & "forme", vbDirectory) = "" Then '<== check if folder exists
   MkDir ThisWorkbook.Path & Application.PathSeparator & "forme" '<== Create Folder
End If
myFile = ThisWorkbook.Path & Application.PathSeparator & "forme" & Application.PathSeparator & strPathFile
'myFile = ThisWorkbook.Path & Application.PathSeparator & strPathFile


'export to PDF if a folder was selected
If myFile <> "False" Then
With wsA.PageSetup
    .Orientation = xlPortrait
    .PrintArea = "SelectedRange"
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
End With
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
        
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Impossibile creare il file pdf"
    Resume exitHandler
End Sub

上面的代码在我的 Windows PC(windows 7,office 2010-13)上运行良好,但是当我在 Mac 上运行时它不起作用。并产生错误。

错误出现GeneratePDF在我们创建文件夹的位置(如果不存在)。

我在哪里做错了?请帮忙

标签: vbamacosdirectorypdf-generationcreate-directory

解决方案


推荐阅读