Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


63123 / 76738 ←次へ | 前へ→

【18214】Re:プリンタコードの取得 訂正
発言  ichinose  - 04/9/18(土) 13:25 -

引用なし
パスワード
   IROC さん、kumaさん、こんにちは。

訂正です。


>このサイトにAPIを使用した取得方法が掲載されていたはずなんですが、
>V3まで探したけど、みつかりませんでした。
>で、ちょっと遅いけど、こんな方法を試してみて下さい。
>標準モジュール(Module1)に
>'================================================================
>Sub プリンター取得()
>'アクティブシートのセルA1からプリンタ名を設定する
>  Dim pr_name
>  If open_printer = True Then
>    idx = 1
>    pr_name = get_printer(True)
>    Do While pr_name <> ""
>     Cells(idx, 1).Value = pr_name
>     idx = idx + 1
>     pr_name = get_printer(False)
>     Loop
>    Call close_printer
>    End If
> 
>End Sub

>別の標準モジュール(Module2)に
↓を差し替えて下さい
'=======================================================
' プリンター名i/oプロシジャーパック
'=======================================================
Private fol
Private folds
Private pr_array() As String
Private pr_idx()
Private e_app As Application
Private job_pr, job_prnm, cur_pr
Private gpflg As Boolean
'============================================================
Function open_printer() As Boolean
'プリンター名をpr_arrayに、FolderitemのIDをpr_idx()にセット
'  output open_printer true 正常終了
'             false 異常終了
  On Error GoTo err_open_printer
  Dim myshell
  open_printer = True
  Erase pr_array
  Erase pr_idx
  Set e_app = Nothing
  Set myshell = CreateObject("shell.application")
  Set fol = myshell.NameSpace(4)
  Set folds = fol.items
  gpflg = False
  idx = 0: jdx = 1
  Do While idx <= folds.Count - 1
    Set fold = folds.Item(idx)
    If IsNumeric(fol.GetDetailsOf(fold, 1)) Then
     ReDim Preserve pr_array(1 To jdx)
     pr_array(jdx) = fold.Name
     ReDim Preserve pr_idx(1 To jdx)
     pr_idx(jdx) = idx
     jdx = jdx + 1
     End If
    idx = idx + 1
    Loop
ret_open_printer:
  Set myshell = Nothing
  On Error GoTo 0
  Exit Function
err_open_printer:
  MsgBox Error$(Err.Number)
  open_printer = False
  Resume ret_open_printer
End Function

'============================================================
Function get_printer(Optional first As Boolean = False)
' プリンターを取り出す(dir関数に使い方が似てる?)
' input  first : true  最初のプリンタ
'          false 次のプリンタ
' output get_printer_name : プリンタ
  
  On Error Resume Next
  Static idx
  If first = True Then
    Set e_app = CreateObject("excel.application")
    job_pr = e_app.ActivePrinter
    e_app.Quit
    Set e_app = Nothing
    For idx = 1 To UBound(pr_array())
     ans = InStr(job_pr, pr_array(idx))
     If ans > 0 Then
       job_prnm = pr_array(idx)
       Exit For
       End If
     Next
    cur_pr = ActivePrinter
    ActivePrinter = job_pr
    gpflg = True
    idx = 1
    End If
  get_printer = ""
  If idx <= UBound(pr_array()) Then
    nm = pr_array(idx)
    Call set_used_printer(nm)
    If idx = 1 Then Call set_used_printer(nm)
    Do Until ActivePrinter Like "*" & nm & "*"
     DoEvents
     Loop
    get_printer = ActivePrinter
    idx = idx + 1
  Else
    ActivePrinter = cur_pr
    Call set_used_printer(job_prnm)
    Do Until ActivePrinter = job_pr
     DoEvents
     Loop
    ActivePrinter = cur_pr
    gpflg = False
    End If
   On Error GoTo 0
End Function
'============================================================
Function get_printer_job_count(pr_nm)
'指定されたプリンタ名に該当するプリンタのジョブ数を取得する
'input pr_nm : プリンタ名
'output get_printer_job_count 数値:正常ジョブ数 false:失敗
  On Error Resume Next
  Dim id
  id = WorksheetFunction.Match(pr_nm, pr_array(), 0)
  If Err.Number = 0 Then
    get_printer_job_count = fol.GetDetailsOf(folds.Item(pr_idx(id)), 1)
    If Err.Number <> 0 Then
     get_printer_job_count = False
     End If
   Else
    get_printer_job_count = False
    End If
  On Error GoTo 0
End Function
'============================================================
Function set_used_printer(pr_nm) As Long
'指定されたプリンタ名に該当するプリンタを通常使うプリンタに設定
'input pr_nm : プリンタ名
'output set_used_printer 0:正常 その他:失敗
  On Error Resume Next
  Dim id
  id = WorksheetFunction.Match(pr_nm, pr_array(), 0)
  If Err.Number = 0 Then
    set_used_printer = 0
    folds.Item(pr_idx(id)).InvokeVerb "通常使うプリンタに設定(&F)"
    If Err.Number <> 0 Then
     set_used_printer = Err.Number
     End If
   Else
    set_used_printer = 1
    End If
  On Error GoTo 0
End Function
'============================================================
Sub close_printer()
'プリンタ名i/oの終了
  On Error Resume Next
  If gpflg = True Then
    ActivePrinter = cur_pr
    Call set_used_printer(job_prnm)
    Do Until ActivePrinter = job_pr
     DoEvents
     Loop
    ActivePrinter = cur_pr
    End If
  Erase pr_array
  Erase pr_idx
  Set fol = Nothing
  Set folds = Nothing
  On Error GoTo 0
End Sub


>
>確認してみて下さい。私の環境(Win98+Excel2000)では
>うまく動いてくれました。

1 hits

【18184】プリンタコードの取得 kuma 04/9/17(金) 11:54 質問
【18186】Re:プリンタコードの取得 IROC 04/9/17(金) 14:14 回答
【18187】Re:プリンタコードの取得 kuma 04/9/17(金) 15:41 発言
【18188】Re:プリンタコードの取得 IROC 04/9/17(金) 16:32 回答
【18192】Re:プリンタコードの取得 ichinose 04/9/17(金) 18:25 発言
【18214】Re:プリンタコードの取得 訂正 ichinose 04/9/18(土) 13:25 発言
【18238】Re:プリンタ一覧の取得 shousuke 04/9/18(土) 23:55 発言
【18239】Re:プリンタ一覧の取得 shousuke 04/9/18(土) 23:58 発言
【18314】Re:プリンタ一覧の取得 kuma 04/9/21(火) 11:44 お礼
【18358】Re:プリンタ一覧の取得 ichinose 04/9/21(火) 22:11 発言
【18431】Re:プリンタ一覧の取得 shousuke 04/9/23(木) 18:27 お礼
【18585】Re:プリンタ一覧の取得 kuma 04/9/30(木) 12:15 お礼

63123 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free