Ｐａｇｅ 796 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼印刷前にプリンタを選択 maeda 03/2/23(日) 17:45 ┗Re:印刷前にプリンタを選択 つん 03/2/25(火) 16:15 ┗Re:印刷前にプリンタを選択 maeda 03/2/25(火) 17:01 ─────────────────────────────────────── ■題名 ： 印刷前にプリンタを選択 ■名前 ： maeda <fwhn0621@mb.infoweb.ne.jp> ■日付 ： 03/2/23(日) 17:45 -------------------------------------------------------------------------
| エクセルファイルに汎用性（どのＰＣでも）を持たせる為に、印刷処理前にリストボックス等で使用中の全てのプリンタを表示し、印刷するプリンタを2個指定し変数に取り込み、その後マクロでプリンタ１を印刷、プリンタ２で再度印刷。といった処理をしたいのですが、プリンタの選択処理が分かりません、ご教授ください。 |
| maeda さん、こんにちは >エクセルファイルに汎用性（どのＰＣでも）を持たせる為に、印刷処理前にリストボックス等で使用中の全てのプリンタを表示し、印刷するプリンタを2個指定し変数に取り込み、その後マクロでプリンタ１を印刷、プリンタ２で再度印刷。といった処理をしたいのですが、プリンタの選択処理が分かりません、ご教授ください。 以前、私が作ったツールに似た（というかほとんど一緒？）機能がありますので、それをご紹介してみます。 私も、友達に教えていただいた方法なんですけど・・・・ とりあえず、フォームにリストボックスとコマンドボタンを一つずつ配置して、リストボックスにインストールされているプリンターをリストし、コマンドボタンで、選択しているプリンターをポート名付きで表示させました。ActivePrinterプロパティに設定する値ね♪ コメント等・・・そのままにしときます。 友達の所から来たそのまんまやけど〜（＾＾; '**標準モジュール*******************************************: '━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ '【関数名】 GetProfileString '【機能】 WIN.INIから指定されたエントリの文字列を取得する '【引数】 ' lpAppName: String−エントリを検索するセクション ' lpKeyName: String−検索するキー名またはエントリ ' lpDefault: String−指定されたエントリが見つからなかった時に返される規定値 ' lpReturnedString: ' String−nSizeバイトを割り当てる文字列バッファ ' nSize: Long−lpReturnedStringに格納できる最大文字数 '【戻り値】 lpReturnedStringバッファにコピーされたバイト数（最後のNull文字は含まれない） '━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ '■ GetProfileString API関数（WIN.INIから指定されたエントリの文字列を取得する） Private Declare Function GetProfileString Lib "kernel32.dll" Alias "GetProfileStringA" _ (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, _ ByVal lpReturnedString As String, ByVal nSize As Long) As Long '================================================================================================== 'プリンタ名一覧を取得する関数 '戻り値：登録されているプリンタの数 'arg_vntPrinter():プリンタ名一覧（配列） 'arg_vntPort()：ポート名一覧（配列） 'arg_strErr:エラーメッセージ Public Function pb_fncGetPrinter(ByRef arg_vntPrinter() As Variant, _ ByRef arg_vntPort() As Variant, ByRef arg_strErr As String) As Long Const STR_APPNAME As String = "Devices" '目的のキーが所属しているセクションの名前（lpAppName） Const STR_DEFAULT As String = "見つかりませんでした" '規定の文字列(lpDefault) Const LNG_SIZE As Long = 1024 '情報を格納するバッファのサイズ(nSize) Const STR_KEYNAME As String = vbNullString 'セクション内の全てのキーを取得(NULLを指定) Dim lngRet As Long 'GetProfileString関数の戻り値 Dim strReturnedString As String * 1024 Dim strTmp As String Dim lngNull As Long Dim i As Long Dim lngStart As Long Dim strErr As String On Error GoTo ErrHandler '-Start--------------------------------------------------------- 'プリンタ一覧を取得 '指定したセクション名を検索、セクションの全キーを取得、該当データのバイト数を返す 'バッファ（strReturnedString）に格納された文字数が返る lngRet = GetProfileString(STR_APPNAME, STR_KEYNAME, STR_DEFAULT, strReturnedString, LNG_SIZE) '最後のNULLを除く strTmp = Left(strReturnedString, InStr(1, strReturnedString, Chr(0) & Chr(0)) - 1) '戻り値チェック If strTmp = STR_DEFAULT Then strErr = "プリンター名が取得できませんでした" GoTo ErrHandler End If lngNull = 0 i = 0 lngStart = 0 Do i = i + 1 lngNull = InStr(lngNull + 1, strTmp, Chr(0)) If lngNull = 0 Then lngNull = Len(strTmp) ReDim Preserve arg_vntPrinter(1 To i) arg_vntPrinter(i) = Mid(strTmp, lngStart + 1, lngNull - lngStart) If Right(arg_vntPrinter(i), 1) = Chr(0) Then '末尾のNULLを削除 arg_vntPrinter(i) = Left(arg_vntPrinter(i), Len(arg_vntPrinter(i)) - 1) End If lngStart = lngNull Loop Until lngNull = Len(strTmp) '-End----------------------------------------------------------- pb_fncGetPrinter = i ReDim arg_vntPort(1 To i) '-Start--------------------------------------------------------- 'ポート一覧を取得 For i = 1 To pb_fncGetPrinter lngRet = GetProfileString(STR_APPNAME, arg_vntPrinter(i), STR_DEFAULT, strReturnedString, LNG_SIZE) '最後のNULLを除く strTmp = Left(strReturnedString, InStr(1, strReturnedString, Chr(0)) - 1) strTmp = Mid(strTmp, InStr(1, strTmp, ",") + 1) '戻り値チェック If strTmp = STR_DEFAULT Then strErr = "ポート名が取得できませんでした" GoTo ErrHandler Else arg_vntPort(i) = strTmp End If Next i '-End----------------------------------------------------------- Exit Function ErrHandler: arg_strErr = strErr & vbCrLf & _ "フォームを閉じて終了させてください。" & _ vbCrLf & vbCrLf & Err.Number & " : " & Err.Description pb_fncGetPrinter = 0 End Function '**フォーム*******************************************: Private pr_strPrinterArray() As String 'プリンター＆ポートのフルネーム '================================================================================================== Private Sub CommandButton1_Click() With ListBox1 If .ListIndex = -1 Then MsgBox "なにも選択されていません" Else MsgBox "選択されているプリンターは" & pr_strPrinterArray(.ListIndex + 1) & " です" End If End With End Sub '================================================================================================== Private Sub UserForm_Initialize() Dim strErrMsg As String Dim vntPrinter() As Variant 'プリンター名（配列） Dim vntPort() As Variant 'ポート名（配列） Dim lngPrinterCount As Long 'pb_fncGetPrinerの戻り値（登録されているプリンター数） Dim strActivePrinter As String Dim i As Long On Error GoTo ErrHandler '-Start--------------------------------------------------------- 'プリンター名、ポート名の設定 lngPrinterCount = pb_fncGetPrinter(vntPrinter(), vntPort(), strErrMsg) If lngPrinterCount = 0 Then Resume ErrHandler ReDim pr_strPrinterArray(1 To lngPrinterCount) strActivePrinter = Application.ActivePrinter If strActivePrinter Like "* on *" = True Then strActivePrinter = Trim(Left(strActivePrinter, InStr(strActivePrinter, " on ") - 1)) For i = 1 To lngPrinterCount pr_strPrinterArray(i) = vntPrinter(i) & " on " & vntPort(i) Next ElseIf strActivePrinter Like "* の *" = True Then strActivePrinter = Trim(Mid(strActivePrinter, InStr(strActivePrinter, " の ") + 3)) For i = 1 To lngPrinterCount pr_strPrinterArray(i) = vntPort(i) & " の " & vntPrinter(i) Next End If With ListBox1 For i = 1 To lngPrinterCount .AddItem vntPrinter(i) Next i End With '-End---------------------------------------------------------- Exit Sub ErrHandler: If Len(strErrMsg) = 0 Then strErrMsg = "フォームの表示段階でエラーが発生しました" & vbCrLf & _ "フォームを閉じて終了させてください。" & vbCrLf & vbCrLf & _ Err.Number & " : " & Err.Description End If MsgBox strErrMsg, vbCritical End Sub API関数は私もちょっち苦手で、詳しい説明を求められたらちと困るかも（＾＾; そのときは、きっと誰かが助けてくれるやんねー♪（すんません・・頼りなくて） |
| ▼つん さん： >maeda さん、こんにちは 早速の回答ありがとうございます。 私がやりたかったとおりのようです、早速明日試して見ます（今日は時間が足りそうにありません） よかった よかった！！ |