| 
    
     |  | ふきゅ さん、こんばんわ。 
 >やりたい場所がエクセル上にリストボックスを貼り付けてそこ限定なんです。
 
 かっこいいやり方ではないですが、
 通常使うプリンタを変更 → 情報取得を繰り返します。
 
 
 Sub tempo()
 Dim win As Object, Acp As String, objItem As Object, rr As Long
 Set win = CreateObject("Shell.Application")
 '
 Acp = Application.ActivePrinter
 '
 Workbooks.Add
 '
 For Each objItem In win.NameSpace(4).items
 If Left(objItem.Name, 4) <> "プリンタ" Then
 rr = rr + 1
 objItem.InvokeVerb "通常使うプリンタに設定(&F)"
 ActiveSheet.Cells(rr, 1).Value = objItem.Name
 DoEvents 'これを入れないと反映されないみたいでした
 ActiveSheet.Cells(rr, 2).Value = Application.ActivePrinter
 If Acp = Application.ActivePrinter Then _
 ActiveSheet.Cells(rr, 3).Value = "←"
 End If
 Next
 '戻す
 Application.ActivePrinter = Acp
 DoEvents 'これを入れないと反映されないみたいでした
 End Sub
 
 こんな感じです。
 A列の値をリストボックスに入れて、B列の値でActivePrinterを設定するようにしたらいいと思います(そのときは別にセルに入れなくてもいいですよ)。
 
 |  |