マクロの初心者です。お教え下さい。
ブックの中に複数のシートがあります。
どのシートにも「個人別データ」という名前のシートが無い時に
「個人別データのシートがありません。」とメッセージボックスを
表示させ、マクロを終了したいのです。
下記の通り記述すると、個人別データの
シートがあっても「個人別データのシートがありません。」と
メッセージボックスが表示されてしまい、うまく行きません。
ご教授下さい。
Dim Sh As Worksheet
For Each Sh In Sheets
If Not Sh.Name = "個人別データ" Then
MsgBox "個人別データのシートがありません。"
Exit Sub
End If
Next
Access 2003 のランタイムでMDEファイルとしてシステム稼働させたいと思います。印刷時、用紙設定やマージン設定をした上で印刷するようにしたいのですが、デザインモードが使用できないので動きません。Ｂ６サイズの伝票サイズの印刷がうまくできません。下記のプロシージャーを組んであります。ランタイムでうまく印刷する方法をご教示ください。
Public Sub SetCustomPage(rptName As String, MyPaperSize As Integer, MyOrientation As Integer, MySource As Integer, MyTop As Long, MyBot As Long, MyLeft As Long, MyRight As Long)
Dim DevString As str_DEVMODE
Dim DM As type_DEVMODE
Dim strDevModeExtra As String
Dim rpt As Report
Dim intResponse As Integer
Const DM_PAPERSIZE = &H2
Const DM_PAPERLENGTH = &H4
Const DM_PAPERWIDTH = &H8
' デザイン ビューでレポートを開きます。
DoCmd.OpenReport rptName, acDesign
Set rpt = Reports(rptName)
rpt.Visible = False
Call SetPageSize(rpt, MyPaperSize, MyOrientation, MySource) 'ページ設定：用紙サイズ、トレイ
Call SetMargins(rpt, MyTop, MyBot, MyLeft, MyRight) 'ページ設定：余白
Set rpt = Nothing
DoCmd.Close acReport, rptName, acSaveYes
End Sub
Private Sub SetPageSize(rpt As Report, MyPaperSize As Integer, MyOrientation As Integer, MySource As Integer)
Dim DevString As str_DEVMODE
Dim DM As type_DEVMODE
Dim strDevModeExtra As String
Dim intResponse As Integer
Const DM_PAPERSIZE = &H2
Const DM_PAPERLENGTH = &H4
Const DM_PAPERWIDTH = &H8
If Not IsNull(rpt.PrtDevMode) Then
strDevModeExtra = rpt.PrtDevMode
' 現在の DEVMODE 構造体を取得します。
DevString.RGB = strDevModeExtra
LSet DM = DevString
' 設定の変更が選択されました。
' フィールドを初期化します。
DM.lngFields = DM.lngFields Or DM_PAPERSIZE Or DM_PAPERLENGTH Or DM_PAPERWIDTH
DM.intPaperSize = MyPaperSize '指定の用紙サイズを設定します。A4かユーザー指定B6紙。
DM.intOrientation = MyOrientation
'PaperSizeが9ならA4サイズそれ以外は、B6サイズ
DM.intPaperLength = IIf(MyPaperSize = 256, 18.2, 29.7) * 100
DM.intPaperWidth = IIf(MyPaperSize = 256, 12.8, 21) * 100
'A4なら自動トレイ、それ以外なら手差しトレイ
DM.intDefaultSource = MySource '4:手差し、7:自動選択
LSet DevString = DM ' プロパティを更新します。
Mid(strDevModeExtra, 1, 94) = DevString.RGB
rpt.PrtDevMode = strDevModeExtra
End If
End Sub
Private Sub SetMargins(rpt As Report, MyTop As Long, MyBot As Long, MyLeft As Long, MyRight As Long)
Dim PrtMipString As str_PRTMIP
Dim PM As type_PRTMIP
PrtMipString.strRGB = rpt.PrtMip
LSet PM = PrtMipString
PM.xLeftMargin = CLng(MyLeft / 10 * 567) ' 余白を設定します。
PM.yTopMargin = CLng(MyTop / 10 * 567)
PM.xRightMargin = CLng(MyRight / 10 * 567)
PM.yBotMargin = CLng(MyBot / 10 * 567)
LSet PrtMipString = PM ' プロパティを更新します。
rpt.PrtMip = PrtMipString.strRGB
End Sub
