Application.Dialogs(xlDialogPrinterSetup).Show

pcc

Well-known Member
Joined
Jan 21, 2003
Messages
1,382
Office Version
  1. 2021
Platform
  1. Windows
Application.Dialogs(xlDialogPrinterSetup).Show

I got his piece of code some time ago from the message board (thanks to TsTom) and it works fine. However, does anyone know how to change the caption from "Printer setup" (the default), to a user-defined one such as "Please select a printer and ...".
All suggestions appreciated
Thanks
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Hi pcc,

My opinion is same as JP, so it's just my suggestion, why don't you use Userform before show a builtin dialog like this?

Code:
'Place the code below into the userform module
'Please put Label control named label1 and Command button control named CommandButton1

Private Sub UserForm_Activate()
    label1.Caption = Application.ActivePrinter
End Sub

Private Sub CommandButton1_Click()
    Me.Hide
    Application.Dialogs(xlDialogPrinterSetup).Show
    label1.Caption = Application.ActivePrinter
    Me.Show
End Sub




OR use userform insted of the Application.Dialogs. :D

Code:
'Place the code below into the userform module
'Please make Userform with Combobox1 before execute this code

'//Get the version of Windows OS
Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128
End Type
'Private Const VER_PLATFORM_WIN32s = 0           '//Change here in case - Win32s
'Private Const VER_PLATFORM_WIN32_WINDOWS = 1    '//Change here in case - Windows 95/98(?)
Private Const VER_PLATFORM_WIN32_NT = 2          '//Change here in case - Windows NT
Private Declare Function GetVersionEx Lib "kernel32" _
        Alias "GetVersionExA" _
        (lpVersionInformation As OSVERSIONINFO) As Long

Private Type PRINTER_INFO_1 '//Get Printer Information
    flags As Long
    pPDescription As Long
    pName As Long
    pComment As Long
End Type
Private Const PRINTER_ENUM_LOCAL = &H2
Private Const PRINTER_ENUM_CONNECTIONS = &H4    '
Private Declare Function EnumPrinters Lib "WINSPOOL.DRV" Alias "EnumPrintersA" _
    (ByVal flags As Long, _
     ByVal Name As String, _
     ByVal Level As Long, _
     pPrinterEnum As Any, _
     ByVal cdBuf As Long, _
     pcbNeeded As Long, _
     pcReturned As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Source As Any, ByVal length&)

Public Function EnumPrinter() As Variant
    Dim asPrinter() As String
    enumPrinter_Engine PRINTER_ENUM_LOCAL, asPrinter
    If isWindowsNT Then enumPrinter_Engine PRINTER_ENUM_CONNECTIONS, asPrinter
    EnumPrinter = asPrinter
End Function

Public Sub enumPrinter_Engine(ByVal iiEnumType As Long, ByRef ioasPrinter() As String)
    Dim abEnumBuffer() As Byte, cBufferSize As Long
    Dim uPrinterInfo As PRINTER_INFO_1, cStructSize As Long
    Dim lngPrinters As Long
    Dim i As Long, lngStart As Long
    Const lngLevel As Long = 1
    Const lngPrinterMax As Long = 64
    Call EnumPrinters(iiEnumType, vbNullString, lngLevel, ByVal 0&, 0, cBufferSize, lngPrinters)
    If cBufferSize = 0 Then Exit Sub
    ReDim abEnumBuffer(0 To cBufferSize - 1)
    Call EnumPrinters(iiEnumType, vbNullString, lngLevel, abEnumBuffer(0), cBufferSize, cBufferSize, lngPrinters)
    If lngPrinters = 0 Then Exit Sub
    If CntArr(ioasPrinter()) = 0 Then
        lngStart = 0
        ReDim ioasPrinter(0 To lngPrinters - 1)
    Else
        lngStart = UBound(ioasPrinter) + 1
        ReDim Preserve ioasPrinter(0 To lngStart + lngPrinters - 1)
    End If
    cStructSize = Len(uPrinterInfo)
    For i = 0 To lngPrinters - 1
        Call MoveMemory(uPrinterInfo, abEnumBuffer(cStructSize * i), cStructSize)
        ioasPrinter(lngStart + i) = GetPrinterStrings(uPrinterInfo.pName, lngPrinterMax)
    Next i
End Sub
Private Function GetPrinterStrings(ByVal ipString As Long, inBytes As Long) As String
    ReDim abBuffer(0 To inBytes) As Byte
    Call MoveMemory(abBuffer(0), ByVal ipString, inBytes)
    GetPrinterStrings = StrConv(abBuffer(), vbUnicode)
    GetPrinterStrings = Left$(GetPrinterStrings, InStr(GetPrinterStrings, vbNullChar) - 1)
End Function
Private Property Get isWindowsNT() As Boolean
    Dim OsVers As OSVERSIONINFO
    OsVers.dwOSVersionInfoSize = Len(OsVers)
    Call GetVersionEx(OsVers)
    isWindowsNT = (OsVers.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Property
Public Function CntArr(ByVal vntArr As Variant, Optional ByVal lngDimention As Long = 1) As Long
    On Error GoTo Terminate
    CntArr = 0
    CntArr = UBound(vntArr, lngDimention) - LBound(vntArr, lngDimention) + 1
    Exit Function
Terminate:
    Exit Function
End Function


Private Sub UserForm_Initialize()
Dim strsPrinterName As Variant
Me.Caption = "Please select printer"
    With ComboBox1
        For Each strsPrinterName In EnumPrinter()
            .AddItem strsPrinterName
        Next
    End With
End Sub
 
Upvote 0
Thanks for your attention guys. The userform approach suggested by Colo is exactly what I need, and I shall use this code in my application.
Cheers
 
Upvote 0
One other query. I have used Colo's code to get a list of printers on my userform. I have a commandbutton that is clicked to set the activeprinter to the listbox text (I used a listbox rather than a combobox)

Application.ActivePrinter = ListBox1.TextValue

When the code executes, I get an error
"Method 'ActivePrinter' of object '_Application' failed"

The listbox1.Text is "\\DEWPS002\W1557501", but the immediate window
shows the Application.Printer as "\\DEWPS004\W599768 on Ne02:"

It seems that I need to specify the "on Ne02:" bit as well, but I don't know the syntax. Can anyone please help??
 
Upvote 0
Hi pcc, :D
It seems that I need to specify the "on Ne02:" bit as well, but I don't know the syntax.
You bet! So the code would be something like this.
Code:
Application.ActivePrinter = ListBox1.TextValue & " on Ne02:"

But please note the part " on Ne02:" would depends on the Windows version and Windows language version. (must be...)

So if my code does not work, let me know again. I'll ask someone who uses English version to help you. :D
 
Upvote 0
Thaks Colo. I'm aware that I can hard-code the" on Ne02:" bit, but I don't want to put any hard code into the procedure in case it doesn't work for some users (I can't check it out for them all), or in case it might change in the future due to say a server change or an operating system upgrade.
If you can come up with a 'generic' way to do this I would be very grateful.
Thanks for your help so far.
Cheers
 
Upvote 0

Forum statistics

Threads
1,225,388
Messages
6,184,681
Members
453,252
Latest member
ok_lets

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top