title image


Smiley Re: Dropdownfeld in Menüleiste zwecks Anzeige akivierter Drucker??????
Hier habe ich was gefunden, das habe ich mal irgendwie irgendwo aufgegabelt.

Ich glaube das funktioniert gut.

Aber schon mal danke an Dich, Hubert, und Dich, Alexandra!

Gruß

Reiner





Option Explicit



Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" _

(ByVal lpString1 As String, ByVal lpString2 As Long) As Long



Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" _

(ByVal lpString As Long) As Long



Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" _

(ByVal flags As Long, ByVal name As String, ByVal Level As Long, _

pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) _

As Long



Private Type OSVERSIONINFO

OSVSize As Long

dwVerMajor As Long

dwVerMinor As Long

dwBuildNumber As Long

PlatformID As Long ' OS platform

szCSDVersion As String * 128

End Type



Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _

(lpVersionInformation As OSVERSIONINFO) As Long



Private Const VER_PLATFORM_WIN32_NT = 2

Private Const PRINTER_ENUM_LOCAL = &H2& ' lokale Drucker NT, alle Win9X

Private Const PRINTER_ENUM_CONNECTIONS = &H4& ' verbundene Netzwerkdrucker NT



Private Const myTag = "PrtList82003"

Private Const Leiste = "Menu Bar"

Private Const myKey1 = "HKEY_CURRENT_USER\Software\Microsoft\Office\"

Private Const myKey2 = "\Word\Options"



Sub AutoExec()

Refresh_PrinterList

End Sub



Sub AutoNew()

Refresh_CB

End Sub



Sub AutoOpen()

Refresh_CB

End Sub



Sub AutoClose()



Dim d As Document, cb As CommandBarComboBox

On Error Resume Next

For Each d In Application.Documents

Set cb = d.CommandBars(Leiste).FindControl(msoControlDropdown, , myTag)

If Not cb Is Nothing Then SyncCB cb

Next d



With cb

.Enabled = False

End With



End Sub







Sub Init_PrinterList()

' Erzeugung des Printer-Combobox in Symbolleiste

' nur einmal aufrufen!

Dim cb As CommandBarComboBox

Dim i As Long, j As Long, PN As Variant, DefPrt As String



On Error Resume Next

CustomizationContext = NormalTemplate

Set cb = CommandBars.FindControl(msoControlDropdown, , myTag)

If Not cb Is Nothing Then cb.Delete

PN = PrinterNames

If IsArray(PN) Then

Set cb = CommandBars(Leiste).Controls.Add(msoControlDropdown, , , 19)

With cb

.Tag = myTag

.BeginGroup = True

.Caption = "Druckerliste"

.TooltipText = "Standard-Drucker für Word"

.OnAction = "PrtComboBoxChange"

.Width = CentimetersToPoints(6.5)

.DropDownWidth = -1

.DropDownLines = 0

.ListHeaderCount = -1

End With

Refresh_PrinterList

End If

End Sub



Sub Refresh_PrinterList()

Dim cb As CommandBarComboBox

Dim i As Long, j As Long, PN As Variant, DefPrt As String, r As Boolean



On Error Resume Next

CustomizationContext = NormalTemplate

Set cb = CommandBars(Leiste).FindControl(msoControlDropdown, , myTag)

PN = PrinterNames

If IsArray(PN) And Not cb Is Nothing Then

DefPrt = Application.ActivePrinter

With cb ' check exisiting extries

For i = 0 To UBound(PN)

If PN(i) .List(i + 1) Then r = True: Exit For

Next i

'If Not DefPrt Like .Text & "*" Then r = True

End With

If r Then ' refresh list

With cb

.Clear

For i = 0 To UBound(PN)

.AddItem PN(i)

If DefPrt Like PN(i) & "*" Then j = i

Next i

.ListIndex = j + 1

System.PrivateProfileString(vbNullString, _

myKey1 & CStr(Application.Version) & myKey2, myTag) = _

.List(.ListIndex)

End With

Else

SyncCB cb ' sync index

End If ' refresh

End If

End Sub



Sub Refresh_CB()



Dim d As Document, cb As CommandBarComboBox

On Error Resume Next

For Each d In Application.Documents

Set cb = d.CommandBars(Leiste).FindControl(msoControlDropdown, , myTag)

If Not cb Is Nothing Then SyncCB cb

Next d



With cb

.Enabled = True

End With





End Sub



Private Sub SyncCB(cb As CommandBarComboBox)

Dim s As String, i As Long, ts As Boolean

On Error Resume Next

s = System.PrivateProfileString(vbNullString, _

myKey1 & CStr(Application.Version) & myKey2, myTag)

If Len(s) Then

With cb

For i = 1 To .ListCount

If .List(i) = s Then

ts = NormalTemplate.Saved

.ListIndex = i

NormalTemplate.Saved = ts

With Dialogs(wdDialogFilePrintSetup)

.Printer = s

.DoNotSetAsSysDefault = True

.Execute

End With

Exit For

End If

Next i

End With ' CB

End If ' len(s)

End Sub



Private Sub PrtComboBoxChange()

System.PrivateProfileString(vbNullString, _

myKey1 & CStr(Application.Version) & myKey2, myTag) = CommandBars.ActionControl.Text

Refresh_CB

End Sub



' siehe http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdi/prntspol_9fjn.asp



Function PrinterNames() As Variant

Dim Buf() As Long, cbRequired As Long, cbBuffer As Long, nEntries As Long

Dim i As Long, lRet As Long, PrinterInfo() As String

Dim OSV As OSVERSIONINFO, IsNT As Boolean, j As Long, Level As Long



OSV.OSVSize = Len(OSV)

If GetVersionEx(OSV) = 1 Then IsNT = OSV.PlatformID = VER_PLATFORM_WIN32_NT



cbBuffer = 3072: Level = IIf(IsNT, 4, 5)

ReDim Buf((cbBuffer / 4) - 1) As Long

lRet = EnumPrinters(PRINTER_ENUM_LOCAL Or PRINTER_ENUM_CONNECTIONS, _

vbNullString, Level, Buf(0), cbBuffer, cbRequired, nEntries)

If lRet Then

If cbRequired > cbBuffer Then

cbBuffer = cbRequired: ReDim Buf(cbBuffer \ 4) As Long

lRet = EnumPrinters(PRINTER_ENUM_LOCAL Or PRINTER_ENUM_CONNECTIONS, _

vbNullString, Level, Buf(0), cbBuffer, cbRequired, nEntries)

If lRet = 0 Then Exit Function

End If

End If



If nEntries Then ReDim PrinterInfo(nEntries - 1)

j = IIf(Level = 4, 3, 5)

For i = 0 To nEntries - 1

PrinterInfo(i) = Space(lstrlen(Buf(j * i)))

lstrcpy PrinterInfo(i), Buf(j * i)

Next i

If nEntries Then PrinterNames = PrinterInfo



End Function



















geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: