Access VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

157 / 500 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【10135】Re:プリンタの設定について教えてください

VBWASURETA - 08/1/10(木) 18:18 -


	引用なし

	パスワード

▼たけさん：

プリンタ出力の前に質問があります。

>いま作成しているモジュールはＡｃｃｅｓｓからＥｘｃｅｌのシートに書き出し
>Ｅｘｃｅｌのシートを出力したいのです。

この部分はできているのでしょうか？
又、シートに出力はエクスポートのみして印刷操作はExcelからでしょうか？

>'このサンプルは少し手を加えてます。
>Sub main()
>　　Set WshNet = CreateObject("Wscript.Network")

>　　With WshNet.EnumPrinterConnections
>　　　　For i = 0 To .Count - 1 Step 2
>　　　　　　If (MsgBox("[" & .Item(i + 1) & "]このプリンタに設定しますか？", vbYesNo) = vbYes) Then
>　　　　　　　　'ここで通常使うプリンタとして設定する。
>　　　　　　　　WshNet.SetDefaultPrinter .Item(i + 1)　 '.Item(i + 1) はインストールされているプリンタ名の配列
>　　　　　　　　Exit For
>　　　　　　End If
>　　　　Next
>　　End With
>
>End Sub

因みに上記に書いたこのサンプルコードは通常使うプリンタを変更するソースです。
なので、アプリ共通で通常使うプリンタが変わる事になります。
ただ、最後に元のプリンタに戻す必要がありますが。

元のプリンタに戻すサンプルを含めた内容は以下のような感じになります。
但し、全てAccessから操作して完了している場合に有効なサンプルです。
※このサンプルもwww2.moug.net/bbs/program/20071210000001.htm に記載された
　内容から作成しています。

sub 印刷_Click()
　　　　Const strOutPrinter = "FUJITSU VSP4901" '変更プリンタ
　　　　Dim strDefaultPrinter As String
　　　　
　　　　'現在の通常使うプリンタ名を列挙
　　　　If GetDefaultPrinter("", "", strDefaultPrinter) = False Then
　　　　　　　　MsgBox "通常使うプリンタが見つかりませんでした"
　　　　　　　　Exit Sub
　　　　End If

　　　　If (MsgBox(印刷を開始しますか？", vbYesNo) = vbYes) Then

　　　　　　　　'指定のプリンタに変更
　　　　　　　　If (FncPrintOut( strOutPrinter ) = False) Then
　　　　　　　　　　　　MsgBox strOutPrinter & "：通常使うプリンタが見つかりませんでした"
　　　　　　　　　　　　Exit Sub
　　　　　　　　End If

　　　　　　　　'// ここに印刷処理のコードを追加してください

　　　　　　　　'元のプリンタに通常使うプリンタとして戻す
　　　　　　　　If (FncPrintOut( strDefaultPrinter ) = False) Then
　　　　　　　　　　　　MsgBox strDefaultPrinter & "：通常使うプリンタが見つかりませんでした"
　　　　　　　　　　　　Exit Sub
　　　　　　　　End If

　　　　End If
End Sub

'プリンタ変更関数
Function FncPrintOut(StrPrinterName As String ) As Boolean
　　Dim strdefoultprt As String
　　Dim i As Integer
　　
　　FncPrintOut = False
　　Set WshNet = CreateObject("Wscript.Network")
　　With WshNet.EnumPrinterConnections
　　　　For i = 0 To .Count - 1 Step 2
　　　　　　If (.Item(i + 1) = StrPrinterName) Then '変更するプリンタが見つかった
　　　　　　　　'ここで通常使うプリンタとして設定する。
　　　　　　　　WshNet.SetDefaultPrinter .Item(i + 1)　 '.Item(i + 1) はインストールされているプリンタ名の配列
　　　　　　　　　　　　　　FncPrintOut = True
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　End With

End Function

'通常使うプリンタ名取得関数
Function GetDefaultPrinter(strUser, strPassword, oDefault) As Boolean

　　On Error Resume Next
　　GetDefaultPrinter = False
　　
　　Dim oService
　　Dim oPrinter
　　Dim iRetval
　　Dim oEnum
　　
　　iRetval = 1
　　
　　If PConnect("", kNameSpace, strUser, strPassword, oService) Then
　　　　
　　　　Set oEnum = oService.ExecQuery( _
　　　　　　"select DeviceID from Win32_Printer where default=true")
　　Else
　　　　GetDefaultPrinter = 1
　　　　Exit Function
　　
　　End If
　　
　　If Err.Number = 0 Then
　　　　GetDefaultPrinter = True
　　　　 For Each oPrinter In oEnum
　　　　
　　　　　　oDefault = oPrinter.DeviceID
　　　　 Next
　　　　
　　　　 iRetval = 0
　　　　
　　Else
　　　　wscript.echo "通常使うプリンタを取得できません" & vbCrLf _
　　　　　　　　　　　　　& Hex(Err.Number) & " " & Err.Description
　　End If

　　'GetDefaultPrinter = iRetval

End Function

Function PConnect(strServer, strNameSpace, strUser, _
　　　　　　　　　　　　　　　　　　　strPassword, oService)

　　On Error Resume Next

　　Dim oLocator
　　Dim bResult
　
　　oService = Null
　
　　bResult = False
　
　　Set oLocator = CreateObject("WbemScripting.SWbemLocator")

　　If Err = 0 Then

　　　　Set oService = oLocator.ConnectServer(strServer, _
　　　　　　　　　　　　　　 strNameSpace, strUser, strPassword)

　　　　If Err = 0 Then

　　　　　　bResult = True
　　　
　　　　　　oService.Security_.impersonationlevel = 3
　　　　　　oService.Security_.Privileges.AddAsString _
　　　　　　　　　　　　　　　　　　　"SeLoadDriverPrivilege"
　　　　　
　　　　　　Err.Clear
　　　
　　　　Else

　　　　　　wscript.echo "処理エラー" & vbCrLf _
　　　　　　　 & Hex(Err.Number) & " " & Err.Description
　　　　End If
　
　　Else
　　　　wscript.echo "処理エラー" & vbCrLf _
　　　　　　　　& Hex(Err.Number) & " " & Err.Description
　　　　
　　End If
　
　　PConnect = bResult
　　　　　　
End Function