宏运行速度很快,直到运行不同的宏



交叉发布在这里:

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}!\.rootdefault:StdRegProv")
' get the Devices from the registry
regobj.EnumValues HKEY_CURRENT_USER, "SoftwareMicrosoftWindows NTCurrentVersionDevices", aDevices, aTypes
' find Printer and create full name
For Each vDevice In aDevices
' get port of device
regobj.GetStringValue HKEY_CURRENT_USER, "SoftwareMicrosoftWindows NTCurrentVersionDevices", 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

实际上,以下内容应该可以解决问题。我认为你的方法过于复杂。

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:Temptest.pdf"
CurrentSheet.Select
End Sub

最新更新