vba - 如果不存在,则创建文件夹,使用 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
在我们创建文件夹的位置(如果不存在)。
我在哪里做错了?请帮忙
解决方案
推荐阅读
- javascript - 返回到 Javascript 中的上一个菜单项
- firebase - 如何在 Firebase 和 Flutter 中自动刷新 Token uuid
- json - PyCharm / IntelliJ HTTP 客户端变量不起作用
- reactjs - 状态不立即更新 - 仅在第二次更新 - NEXT.JS
- c# - 在设计时反映用户偏好
- excel - 检查现有数据视觉基础宏
- ansible - Ansible 即席查找
- python - 使用 Python 将 csv 文件转换为 PDF
- javascript - 你是怎么学会编码的?你认为最好和最有效的方法是什么?
- python - 有没有办法使用 Python Regex 提取给定字符串中的特定模式