我在UserForm上有两个按钮:一个用于将UserForm保存为PDF,另一个用于保存为XLSX。 PDF可以正常工作,我只是想添加XLSX可能性,但无法正常工作。 XLSX版本仅在保存为PDF后才能工作。然后,如果我对UserForm进行了一些修改(更改数字等),则无法再次保存到XLSX,因此必须首先保存到PDF。否则,我在下面出现错误。为什么会这样呢?
错误处理程序指向newWB.PasteSpecial Format:=0
API:
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1
PrintScreen:
Private Sub AltPrintScreen()
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
End Sub
保存为PDF:
Private Sub btnPrintPDF_Click()
Application.ScreenUpdating = False
On Error Resume Next
Dim pdfName As String
Dim newWS As Worksheet
Application.DisplayAlerts = False
Call AltPrintScreen
DoEvents
Set newWS = ThisWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
Application.PrintCommunication = False
With newWS.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
End With
Application.PrintCommunication = True
newWS.PasteSpecial Format:=0, Link:=False, DisplayAsIcon:=False
pdfName = Environ$("USERPROFILE") & "\Desktop\" & ThisWorkbook.Sheets("Other Data").Range("P14").Value & "," & " " & "Summary" & "_" & Format(Now, "dd.mm.yyyy") & ".pdf"
newWS.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=pdfName, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
newWS.Delete
On Error GoTo 0
ThisWorkbook.Worksheets("MAIN").Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set newWS = Nothing
End Sub
保存到XLSX:
Private Sub CommandButton5_Click()
Application.ScreenUpdating = False
Dim NewBook As Workbook
Dim newWB As Worksheet
Application.DisplayAlerts = False
Application.PrintCommunication = False
Call AltPrintScreen
DoEvents
Set NewBook = Workbooks.Add
Set newWB = ActiveSheet
With NewBook
newWB.Range("A1").Select
newWB.PasteSpecial Format:=0
.SaveAs FileName:=Environ("USERPROFILE") & "\Desktop\" & ThisWorkbook.Sheets("Other Data").Range("P14").Value & "," & " " & "Summary" & "_" & Format(Now, "dd.mm.yyyy") & ".xlsx"
.Close False
End With
Application.ScreenUpdating = True
Set newWB = Nothing
End Sub