List 7-54　その時点のデフォルトプリンタの状態をDEVMODE構造体に格納する

---

  1： Dim vDevMode As DEVMODE
  2： 
  3： ' 初期値を設定
  4： vDevMode.dmSize = Len(vDevMode)
  5： vDevMode.dmSpecVersion = 0
  6： vDevMode.dmDriverVersion = 0
  7： vDevMode.dmDriverExtra = 0
  8： vDevMode.dmFields = 0
  9： 
 10： On Error Resume Next
 11： 
 12： ' デバイス名
 13： vDevMode.dmDeviceName = Printer.DeviceName
 14： ' 用紙サイズ
 15： If Printer.PaperSize <> vbPRPSUser Then
 16：     ' 定型用紙
 17：     vDevMode.dmFields = vDevMode.dmFields Or DM_PAPERSIZE
 18：     vDevMode.dmPaperSize = Printer.PaperSize
 19：     vDevMode.dmPaperWidth = 0
 20：     vDevMode.dmPaperLength = 0
 21： Else
 22：     ' 不定形用紙
 23：     vDevMode.dmFields = vDevMode.dmFields Or DM_PAPERSIZE Or _
   　                         DM_PAPERLENGTH Or DM_PAPERWIDTH
 24：     vDevMode.dmPaperSize = vbPRPSUser
 25：     vDevMode.dmPaperWidth = Printer.ScaleX(Printer.Width, Printer.ScaleMode, vbHimetric)
 26：     vDevMode.dmPaperLength = Printer.ScaleY(Printer.Height, Printer.ScaleMode, vbHimetric)
 27： End If
 28： 
 29： ' 給紙トレイ
 30： vDevMode.dmDefaultSource = Printer.PaperBin
 31： If Err.Number = 0 Then
 32：     vDevMode.dmFields = vDevMode.dmFields Or DM_DEFAULTSOURCE
 33： Else
 34：      Err.Clear
 35： End If
 36： 
 37： ' 印字品質
 38： vDevMode.dmPrintQuality = Printer.PrintQuality
 39： If Err.Number = 0 Then
 40：     vDevMode.dmFields = vDevMode.dmFields Or DM_PRINTQUALITY
 41： Else
 42：     Err.Clear
 43： End If
 44： 
 45： ' カラー
 46： vDevMode.dmColor = Printer.ColorMode
 47： If Err.Number = 0 Then
 48：     vDevMode.dmFields = vDevMode.dmFields Or DM_COLOR
 49： Else
 50：     Err.Clear
 51： End If
 52： 
 53： ' 両面印刷
 54： vDevMode.dmDuplex = Printer.Duplex
 55： If Err.Number = 0 Then
 56：     vDevMode.dmFields = vDevMode.dmFields Or DM_DUPLEX
 57： Else
 58：     Err.Clear
 59： End If
 60： 
 61： ' 用紙の向き
 62： vDevMode.dmOrientation = Printer.Orientation
 63： If Err.Number = 0 Then
 64：     vDevMode.dmFields = vDevMode.dmFields Or DM_ORIENTATION
 65： Else
 66：     Err.Clear
 67： End If
 68： 
 69： ' 拡大率
 70： vDevMode.dmScale = Printer.Zoom
 71： If Err.Number = 0 Then
 72：     vDevMode.dmFields = vDevMode.dmFields Or DM_SCALE
 73： Else
 74：     Err.Clear
 75： End If
 76： 
 77： ' エラーハンドラの解除
 78： On Error GoTo 0