Сохранить пользовательскую форму как .xlsx на рабочем столе пользователя - PullRequest
0 голосов
/ 09 апреля 2019

У меня есть две кнопки в пользовательской форме: одна для сохранения пользовательской формы в 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...