' [185.xls]





' [Module1] のコード
'★★☆　現在使用しているプリンタ名を表示する　☆★★

Option Explicit

Declare Sub MoveMemory Lib "KERNEL32" Alias "RtlMoveMemory" _
        (Dest As Any, _
        Source As Any, _
        ByVal length&)

Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" _
        (ByVal Flags As Long, _
        ByVal Name As String, _
        ByVal Level As Long, _
        pPrinterEnum As Byte, _
        ByVal cdBuf As Long, _
        pcbNeeded As Long, _
        pcReturned As Long) As Long

Public Const PRINTER_ENUM_LOCAL = &H2
Public Const PRINTER_ENUM_NAME = &H8
Public Const PRINTER_ENUM_SHARED = &H20
Public Const PRINTER_ENUM_DEFAULT = &H1

Type PRINTER_INFO_1
  Flags As Long
  pDescription As Long 'プリンタに関する情報
  pName As Long        'プリンタ名
  pComment As Long     'プリンタの説明
End Type

Public Function gGetStrFromPtr(pString As Long, nBytes As Long) As String
  ReDim BufArray(nBytes) As Byte

  Call MoveMemory(BufArray(0), ByVal pString, nBytes)

  gGetStrFromPtr = gGetStrFromBuffer(StrConv(BufArray(), vbUnicode))

End Function

Public Function gGetStrFromBuffer(sString As String) As String
  
  If InStr(sString, vbNullChar) Then
    gGetStrFromBuffer = Left$(sString, InStr(sString, vbNullChar) - 1)
  Else
    gGetStrFromBuffer = sString
  End If

End Function

Sub start()

    UserForm1.Show

End Sub




' [UserForm1] のコード
Option Explicit

Private Sub CommandButton1_Click()
Dim pr As Long
Dim no As Long
Dim Level As Long
Dim pPrinterEnum() As Byte
Dim pcbNeeded As Long
Dim pcReturned As Long
Dim pno() As PRINTER_INFO_1
Dim i As Integer
Dim j As Long

    If Me.Caption = "表示しました" Then Exit Sub
    Level = 1

    pr = EnumPrinters _
        (PRINTER_ENUM_LOCAL, vbNullString, Level, ByVal 0&, 0, pcbNeeded, pcReturned)

    ReDim pPrinterEnum(pcbNeeded - 1) As Byte

    pr = EnumPrinters _
        (PRINTER_ENUM_LOCAL, vbNullString, Level, pPrinterEnum(0), pcbNeeded, pcbNeeded, pcReturned)

    ReDim pno(pcReturned - 1) As PRINTER_INFO_1

    no = Len(pno(0))
    
    With ListBox1
    
        If .ListCount >= 1 Then
            For j = .ListCount To 1 Step -1
                .RemoveItem (.ListIndex)
            Next j
        End If
        
        .AddItem "現在標準のプリンタ　" & Application.ActivePrinter
        .AddItem ""
        
        For i = 0 To pcReturned - 1
            Call MoveMemory(pno(i), pPrinterEnum(no * i), no)
                .AddItem "No." & Format(i + 1)
                .AddItem "プリンタ名" & vbTab & gGetStrFromPtr(pno(i).pName, 64)
                .AddItem "Description" & vbTab & gGetStrFromPtr(pno(i).pDescription, 64)
                .AddItem ""
        
        Next i
    
    End With
    
    Me.Caption = "表示しました"
    
End Sub