| |
▼たけ さん：
プリンタ出力の前に質問があります。
>いま作成しているモジュールはＡｃｃｅｓｓからＥｘｃｅｌのシートに書き出し
>Ｅｘｃｅｌのシートを出力したいのです。
この部分はできているのでしょうか？
又、シートに出力はエクスポートのみして印刷操作は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
|
|
VBWASURETA
- 08/1/10(木) 18:18 -
![[未読]](./data/access/image/read_icon.gif){kind=icon}
