首页 > 解决方案 > 宏运行很快,直到运行不同的宏

问题描述

在这里交叉发布:

https://www.reddit.com/r/excel/comments/ea4zb1/macros_run_quickly_until_different_macro_is_run/

我有一个宏,在最初打开 excel 时运行得相当快。我可以多次运行它,或者运行不同的宏(特别是一个除外),而不会影响性能。我还有一个将文件打印为 pdf 的宏。在我运行这个宏之后,所有其他宏的性能都会受到影响。罪魁祸首代码发布在下面,是否有任何事情导致其他宏运行速度变慢?谢谢

Private Sub Save_Workbook_As_PDF2()



Application.EnableEvents = False

Application.ScreenUpdating = False



Dim sPrinter As String

Dim sDefaultPrinter As String

'Debug.Print "Default printer: ", Application.ActivePrinter

sDefaultPrinter = Application.ActivePrinter ' store default printer

sPrinter = GetPrinterFullName("Adobe PDF")

If sPrinter = vbNullString Then ' no match

Debug.Print "No match"

Else

Application.ActivePrinter = sPrinter

'Debug.Print "Temp printer: ", Application.ActivePrinter

' do something with the temp printer

Sheets(Array("Quote Sheet", "Terms and Conditions")).Select

ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"

Sheets("Quote Sheet").Select

Application.ActivePrinter = sDefaultPrinter

End If

'Debug.Print "Default printer: ", Application.ActivePrinter

Application.EnableEvents = True

Application.ScreenUpdating = True

End Sub



Private Function GetPrinterFullName(Printer As String) As String

' This function returns the full name of the first printerdevice that matches Printer.

' Full name is like "PDFCreator on Ne01:" for a English Windows and like

' "PDFCreator sur Ne01:" for French.

' Created: Frans Bus, 2015. See http://pixcels.nl/set-activeprinter-excel

' see http://blogs.msdn.com/b/alejacma/archive/2008/04/11/how-to-read-a-registry-key-and-its-values.aspx

' see http://www.experts-exchange.com/Software/Microsoft_Applications/Q_27566782.html

Const HKEY_CURRENT_USER = &H80000001

Dim regobj As Object

Dim aTypes As Variant

Dim aDevices As Variant

Dim vDevice As Variant

Dim sValue As String

Dim v As Variant

Dim sLocaleOn As String

' get locale "on" from current activeprinter

v = Split(Application.ActivePrinter, Space(1))

sLocaleOn = Space(1) & CStr(v(UBound(v) - 1)) & Space(1)

' connect to WMI registry provider on current machine with current user

Set regobj = GetObject("WINMGMTS:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

' get the Devices from the registry

regobj.EnumValues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", aDevices, aTypes

' find Printer and create full name

For Each vDevice In aDevices

' get port of device

regobj.GetStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", vDevice, sValue

' select device

If Left(vDevice, Len(Printer)) = Printer Then ' match!

' create localized printername

GetPrinterFullName = vDevice & sLocaleOn & Split(sValue, ",")(1)

Exit Function

End If

Next

' at this point no match found

GetPrinterFullName = vbNullString

End Function

标签: excelvbaprinting

解决方案


实际上,以下应该可以解决问题。我认为您的方法不必要地复杂。

Option Explicit

Private Sub Save_Workbook_As_PDF2()
    Dim CurrentSheet As Worksheet
    Set CurrentSheet = ThisWorkbook.ActiveSheet

    ThisWorkbook.Worksheets(Array("Quote Sheet", "Terms and Conditions")).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\Temp\test.pdf"

    CurrentSheet.Select
End Sub

推荐阅读