エクセルに関連付けられたプリンタ情報削除

質問

VBAでエクセルのファイルに有るプリンタ情報を消すことは可能でしょうか？

office2010をWindowsXPで使用しているのですが、
会社内で色々な部署からエクセルファイルをもらって、チェックをして、
別の部署に引き渡すという作業をしています。
最終的に引き渡された部署（40箇所ぐらい）の方々が、ファイルを印刷するのですが、
印刷情報がエクセルに組み込まれているファイルがあるようで、
白黒で出てくる、両面印刷で出てくる、トナーセーブで出てくる、
想定外のプリンタから出てくるなどクレームが上がってくる事があります。
月に800ファイルほどチェックするので、1つずつ対処するのは大変です。
そこでVBAでプリンタ情報を消すことは可能でしょうか？
処理するパソコンのデフォルトの設定で印刷できるようにしたいです。

沢山のファイルを一気にチェックするVBAなどは作ってあるので、
それに組み込もうと思います。

よろしくお願いします。

回答No.1

mitarashi

エクセルはシート毎に印刷設定を保持していて、これをリセットするにはActivePrinterを切り替えれば良いです。
（さすがにシート毎に実行しなくても良いらしいです。）
http://www.freia.jp/taka/blog/697/

ActivePrinterをWindowsの標準プリンターに設定するコードを書いて（切り貼りして）みましたが、大げさですね。もっとスッキリした回答が寄せられるかも。
参考URLは昔からある記事ですが、Windows7Home, 64bitでも動作しました。

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, lpData As Any, lpcbData As Long) As Long

Private Const KEY_QUERY_VALUE = &H1
Private Const HKEY_CURRENT_USER = &H80000001

'Windowsの標準プリンターをActivePrinterに設定する
Sub ActivateDefaultPrinter()
Dim objWSH As Object
Dim objPrinter As Object
Dim sPrinterList() As String
Dim sTemp1 As String
Dim i As Long
Dim ctr As Long
Dim defaultPrinter As String
Const SUB_ROOT = "Software\Microsoft\Windows NT\CurrentVersion\Devices"

defaultPrinter = getDefaultPrinter
Set objWSH = CreateObject("WScript.Network")
Set objPrinter = objWSH.EnumPrinterConnections
If objPrinter.Count < 2 Then
MsgBox "プリンタを取得できません", vbExclamation
GoTo Exit_Proc
Else
ctr = 0
For i = 0 To objPrinter.Count - 1 Step 2
ReDim Preserve sPrinterList(ctr)
sPrinterList(ctr) = objPrinter(i + 1)
ctr = ctr + 1
Next
End If
For i = 0 To ctr - 1
'Microsoft XPS Document Writer on Ne00: という形式でプリンタとポートを取得します
sTemp1 = RegRead_API(HKEY_CURRENT_USER, SUB_ROOT, sPrinterList(i))
sTemp1 = Replace(sTemp1, "winspool,", "")
If sPrinterList(i) = defaultPrinter Then
Application.ActivePrinter = sPrinterList(i) & " on " & sTemp1
End If
Next

Exit_Proc:
Set objPrinter = Nothing
Set objWSH = Nothing
End Sub

'デフォルトプリンターを取得する
Function getDefaultPrinter() As String
Dim oClassSet As Object
Dim oClass As Object
Dim oLocator As Object
Dim oService As Object
Dim sMesStr As Object

Set oLocator = CreateObject("WbemScripting.SWbemLocator")
Set oService = oLocator.ConnectServer
Set oClassSet = oService.ExecQuery("Select * From Win32_Printer")
For Each oClass In oClassSet
If oClass.Default Then
getDefaultPrinter = oClass.Caption
Exit For
End If
Next
Set oClassSet = Nothing
Set oClass = Nothing
Set oService = Nothing
Set oLocator = Nothing
End Function

'レジストリを開く・読み込む・閉じる。
Private Function RegRead_API(lRoot As Long, sSubRoot As String, sEntryName As String) As String
Dim lRet As Long
Dim hWnd As Long
Dim sVal As String
hWnd = Application.hWnd
lRet = RegOpenKeyEx(lRoot, sSubRoot, 0, KEY_QUERY_VALUE, hWnd)
sVal = String(255, " ")
lRet = RegQueryValueEx(hWnd, sEntryName, 0, 0, ByVal sVal, LenB(sVal))
RegCloseKey hWnd
sVal = Left$(sVal, InStr(sVal, vbNullChar) - 1)
RegRead_API = sVal
End Function

参考URL：

http://blogs.yahoo.co.jp/bardiel_of_may/40864687.html

お礼

返答有難うございます

プリンタ情報を消す事に、こんなに複雑なＶＢＡが必要だったのですね！なめてました！

読解して使わせていただきます！早い返答有難うございます！