在用户桌面上将用户表单另存为.xlsx

时间:2019-04-09 07:48:06

标签: excel vba

我在UserForm上有两个按钮:一个用于将UserForm保存为PDF,另一个用于保存为XLSX。 PDF可以正常工作,我只是想添加XLSX可能性,但无法正常工作。 XLSX版本仅在保存为PDF后才能工作。然后,如果我对UserForm进行了一些修改(更改数字等),则无法再次保存到XLSX,因此必须首先保存到PDF。否则,我在下面出现错误。为什么会这样呢?

错误处理程序指向newWB.PasteSpecial Format:=0

enter image description here

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

0 个答案:

没有答案