bananabongos
bananabongos

Reputation: 3

Macros run quickly, until different macro is run

Cross-posted here:

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

I have a macro, that upon initial opening of excel runs fairly quickly. and I can run it multiple times, or run different macros (except one in particular) with no consequences on performance. I also have a macro that prints the file to pdf. After I run this macro, performance of all other macros suffer. The culprit code is posted below, are there any things that it's doing that's causing other macros to run slower? Thanks

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

Upvotes: 0

Views: 171

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57743

Actually the following should do the trick. I think your approach was unnecessarily complicated.

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

Upvotes: 1

Related Questions