Access 2003 Run Time で印刷設定したい

このQ&Aのポイント
  • Access 2003のランタイムでMDEファイルとしてシステム稼働させたいと思います。デザインモードが使用できないため、印刷時の用紙設定やマージン設定ができません。B6サイズの伝票サイズの印刷をうまく行いたいです。
  • デザインモードが使用できないため、Access 2003のランタイムでMDEファイルとしてシステムを稼働させています。しかし、印刷時に用紙設定やマージン設定ができず、B6サイズの伝票サイズの印刷がうまくできません。どのようにすればランタイムでうまく印刷できるでしょうか。
  • Access 2003のランタイムでMDEファイルとしてシステムを稼働させていますが、デザインモードが使用できません。そのため、印刷時の用紙設定やマージン設定ができず、B6サイズの伝票サイズの印刷が上手くいきません。どのように設定すればランタイムで正しく印刷できるのでしょうか。
回答を見る
  • ベストアンサー

Access 2003 Run Time で印刷設定したい。

Access 2003 のランタイムでMDEファイルとしてシステム稼働させたいと思います。印刷時、用紙設定やマージン設定をした上で印刷するようにしたいのですが、デザインモードが使用できないので動きません。B6サイズの伝票サイズの印刷がうまくできません。下記のプロシージャーを組んであります。ランタイムでうまく印刷する方法をご教示ください。 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

質問者が選んだベストアンサー

  • ベストアンサー
  • bonaron
  • ベストアンサー率64% (482/745)
回答No.1
psgrade
質問者

お礼

早速適切な情報を頂き有難う御座います。 Printerオブジェクトを使用すれば、レポートをデザインモードにすることなく、用紙設定、印刷方向、余白設定等を行えるということですね。 早速、試してみます。

関連するQ&A

  • アクセスのレポートで文字縮小(エクセルの縮小して全体を表示するみたいに)

    教えてください。 アクセスレポートのテキストボックスをそのサイズを変えずに文字を縮小する(エクセルの書式設定の縮小して全体を表示にすると同じように)にはどうしたらよいのでしょうか。 ネットで検索したら あったのですがうまくいきませんでした。 以下引用 **************************** 以前作成したことのある枠内に収まるようフォントサイズを 自動調整する関数です。 Public Sub AutoFontSize(Ctr As Control, IniFontSize As Integer) Const MinFontSize = 4 '最小のフォントサイズ Const d = 40 'うまく収まらずに改行されてしまう場合はここの数値を増やす Dim rpt As Report, Str As String, W As Long Dim arStr, i As Integer, H As Long Set rpt = CodeContextObject With rpt If Ctr.ControlType = acTextBox Then Str = Ctr.Text ElseIf Ctr.ControlType = acLabel Then Str = Ctr.Caption Else Exit Sub End If If Str = "" Then Exit Sub .FontName = Ctr.FontName If Ctr.Vertical Then W = Ctr.Height - d H = Ctr.Width - d If InStr(1, .FontName, "@") = 0 Then .FontName = "@" & .FontName Else .FontName = Mid(.FontName, 2) End If Else W = Ctr.Width - d H = Ctr.Height - d End If arStr = Split(Str, vbCrLf) Str = arStr(0) For i = 1 To UBound(arStr) If .TextWidth(arStr(i)) > .TextWidth(Str) Then Str = arStr(i) Next .ScaleMode = 1 If Ctr.FontBold = 1 Then .FontBold = True .FontSize = IniFontSize Do Until rpt.FontSize = MinFontSize If W > .TextWidth(Str) Then Exit Do End If .FontSize = .FontSize - 1 Loop Do Until rpt.FontSize = MinFontSize If H > .TextHeight("A") * (UBound(arStr) + 1) + Ctr.LineSpacing * UBound(arStr) Then Exit Do End If .FontSize = .FontSize - 1 Loop Ctr.FontSize = .FontSize End With End Sub 使い方は、 前記の関数を標準モジュールに作成します。 レポートのセクションのフォーマット時イベントで、 AutoFontSize Me.テキストボックス名, 12 というように記述します。 第2引数は、フォントサイズの初期値です。 枠内に収まりきらないときは、収まるサイズまで縮小します。 ただし、Const MinFontSize = 4 で指定したサイズまでです。 ******************* というのをそのままコピーして試してみたのですが、 「マクロがみつかりません」というエラーがでてしまいました。 何か他に簡単な方法もしくは上記の表現を補足わかりやすくしてくださるようお願いします。

  • ExcelVBAで他のアプリをスクロールさせたい

    エクセルVBAから 他のアプリのスクロールバーを操作して、指定範囲で画面スクロールしたいと思っています。 キー入力では操作出来ない(マウス操作でのみスクロールされる)アプリなので、 Sendkeysは使えないのではないかと思い、 APIでハンドルを取得して、 SendMessageすればできるかなと思いましたが、APIについてよく分からないので、 とりあえず、メモ帳で以下を作成してみました。しかし、スクロールされません。 どこがいけないのか教えていただけないでしょうか? よろしくお願いします。 *************** Public Declare Function FindWindowA Lib "User32" (ByVal cnm As String, ByVal cap As String) As Long Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Const WM_VSCROLL = &H115 Public Const WM_HSCROLL = &H114 Public Const SB_TOP = &H6& Public Const SB_BOTTOM = &H7& Sub handle_get()  Dim Handle As Long  Dim Ap1 As String  Ap1 = "a.txt - メモ帳"  AppActivate Ap1  Handle = FindWindowA(vbNullString, Ap1)  SendMessage Handle, WM_VSCROLL, SB_BOTTOM, ByVal CLng(0)  SendMessage Handle, WM_HSCROLL, SB_TOP, ByVal CLng(0) End Sub ***************

  • 「コンパイルエラー End Subが必要です。」

    Access2016でファイルを作成しているのですが、下記のVBAを実行しようとすると、「コンパイルエラー End Subが必要です。」とエラーメッセージが返ってきてしまいます。 構文の修正が必要であるとお気づきであれば、その箇所を教えていただけないでしょうか。初歩的な質問で恥ずかしい限りですが、何卒よろしくお願い致します。 Option Compare Database Option Explicit Public Declare PtrSafe Function SetWindowPos Lib "user32" _ (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _ ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _ ByVal fuFlags As Long) As Long Public Declare PtrSafe Function GetSystemMenu Lib "user32" _ (ByVal hWnd As Long, ByVal fRever As Long) As Long Public Declare PtrSafe Function RemoveMenu Lib "user32" _ (ByVal hMenu As Long, ByVal uItem As Long, ByVal fuFlags As Long) As Long Public Const SWP_NOMOVE = &H2 Public Const SWP_NOSIZE = &H1 Public Const HWND_TOP = &H0 Public Const SC_SIZE = &HF000 Public Const SC_MAXIMIZE = &HF030 Public Const SC_CLOSE = &HF060 Public Const SC_RESTORE = &HF120 Public Const MF_BYCOMMAND = &H0& Public Sub test() Private Sub Form_Open(Cancel As Integer) Dim hWnd As Long hWnd = Application.hWndAccessApp SetWindowPos hWnd, HWND_TOP, 0, 0, 800, 600, SWP_NOMOVE hWnd = GetSystemMenu(hWnd, 0) RemoveMenu hWnd, SC_SIZE, MF_BYCOMMAND End Sub

  • タスクトレイからアイコンを削除したい

    VB6.0にて、自作のアプリ「zisaku.exe」から、タスクトレイ常駐型の他アプリケーション「aiueo.exe」を再起動したいと考えています。 しかし、色々調べて試してみたのですが、Shell_NotifyIconに設定する設定値が分からず困っています。教えていただけないでしょうか。 (「aiueo.exe」はウィンドウを持たない) 動作フロー (1)「aiueo.exe」のプロセスを削除する。(タスクマネージャにて確認。動作OK) (2)「aiueo.exe」のタスクトレイアイコンを削除する。(設定値が分からない) (3)「aiueo.exe」を起動する。(起動後は自動でタスクトレイに入る) 開発環境 WindowsXP SP2 VB6.0-SP6 コード 'タスクトレイ関連の構造体と定数 Private Type NOTIFYICONDATA cbSize As Long hWnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String * 64 dwState As Long dwStateMask As Long End Type Private Const NIF_ICON = &H2 Private Const NIF_MESSAGE = &H1 Private Const NIF_TIP = &H4 Private Const NIM_ADD = &H0 Private Const NIM_DELETE = &H2 Private Const NIM_MODIFY = &H1 Private Const WM_MOUSEMOVE = &H200 Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Private Const WM_RBUTTONDBLCLK = &H206 Private Const WM_RBUTTONDOWN = &H204 Private Const WM_RBUTTONUP = &H205 Private Sub aiueoReStart() Dim intCnt As Integer Dim lngRet As Long Dim strBuf As String Dim strSql As String Dim lobjProcess As Object Dim lstrModule As String Dim NID As NOTIFYICONDATA lstrModule = "aiueo.exe" 'プロセスを削除する。 strSql = "SELECT * FROM win32_process WHERE name='" & lstrModule & "'" For Each lobjProcess In GetObject("winmgmts:").ExecQuery(strSql) If lstrModule = lobjProcess.Name Then lobjProcess.Terminate End If Next 'Shell_NotifyIconを使ってタスクトレイより削除する。 'NIDの設定値が分からない。 '色々試して見たけど巧くいかなかった。 Shell_NotifyIcon NIM_DELETE, NID lngRet = Shell("C:\Program Files\aiueo.exe", vbNormalNoFocus) If lngRet = 0 Then lngRet = MsgBox("起動失敗!", vbCritical) End If Exit Sub End Sub 以上です。 どうかよろしくお願い致します。 (質問するカテゴリを間違えていたため、一時削除しました。申し訳ありません。)

  • 擬似マインスイーパー

    任意の地雷を設置するというプログラムです。 この中で地雷を*に、安全地帯を空白にしたいのですがやり方がわからないので、わかる方お願いします。 Sub mine() Dim minefield(11, 13) As Integer Dim i As Integer, a As Integer, b As Integer Dim c As Integer c = InputBox("地雷の数を決めます") Randomize For i = 1 To c a = Int(Rnd * 10) + 1 b = Int(Rnd * 12) + 1 If minefield(a, b) = 9 Then i = i - 1 minefield(a, b) = 9 Next i countMine minefield, 10, 12 showInt minefield, 10, 12 ' show minefield, 10, 12 End Sub Sub countMine(f() As Integer, h As Integer, w As Integer) Dim i As Integer, j As Integer Dim a As Integer, b As Integer Dim x As Integer For a = 1 To 10 For b = 1 To 12 If f(a, b) < 9 Then x = 0 If f(a, b - 1) = 9 Then x = x + 1 '左に地雷があるか If f(a, b + 1) = 9 Then x = x + 1 '右に地雷があるか ' ... この部分に追加したいのだが ... f(a, b) = x End If Next b Next a End Sub Sub showInt(f() As Integer, h As Integer, w As Integer) Dim i As Integer Const a As Integer = 7 Const b As Integer = 3 Do While h > 0 For i = 1 To w Cells(a + h, b + i) = f(h, i) Next i h = h - 1 Loop End Sub

  • 日付を数値型にしたいけどうまくできない

    Sub さんぷる1() Dim testlong As Long testlong = CLng(("2012/12/14")) End Sub をすると、 型が一致しません。になりますが、なぜでしょう? VBAです。

  • プリンタの印刷ジョブを削除したい。

    プリンタの印刷ジョブを削除したい。 現在、VB.NET(Visual Studio 2008)で開発を行っています。 SetPrinter関数を使用して、印刷ジョブを全て削除したいのですがSetPrinterに失敗してしまいます。 GetLastErrorの戻り値は「5」でアクセス拒否のようです。 SetPrinterの前にOpenPrinterは成功しており、プリンタの印刷ジョブの情報は取得できています。 なお、同環境でVB6.0で同様のプログラムを作成し実行したところジョブの削除ができました。 類似した現象・解決方法等ご存知でしたら教えてください。 開発環境はWindowsXP、Visual Studio 2008です。 以下、ソースの抜粋です。 '宣言 Private Const DEF_INIT_BUFFER_PERFORM As Integer = 100 Public Const STANDARD_RIGHTS_REQUIRED = &HF0000 Public Const PRINTER_ACCESS_ADMINISTER = &H4 Public Const PRINTER_ACCESS_USE = &H8 Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _ PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE) Public Structure PRINTER_DEFAULTS Public pDatatype As IntPtr Public pDevMode As IntPtr Public DesiredAccess As Integer End Structure <DllImport("winspool.drv", CharSet:=CharSet.Auto, SetLastError:=True)> _ Private Shared Function OpenPrinter( _ ByVal pPrinterName As String, _ ByRef hPrinter As IntPtr, _ ByVal pDefault As PRINTER_DEFAULTS _ ) As Boolean End Function <DllImport("winspool.drv", CharSet:=CharSet.Auto, SetLastError:=True)> _ Private Shared Function SetPrinter( _ ByVal hPrinter As IntPtr, _ ByVal Level As Long, _ ByVal pDefault As IntPtr, _ ByVal Command As Long _ ) As Boolean End Function '実行部 Dim pd As New PRINTER_DEFAULTS pd.DesiredAccess = PRINTER_ALL_ACCESS Dim printerHandle As IntPtr Dim ret As Boolean = OpenPrinter("プリンタ名", printerHandle, pd) Dim err As Integer = Marshal.GetLastWin32Error() 'Falseが返る ret = SetPrinter(printerHandle, CLng(0), IntPtr.Zero, CLng(3)) '5が返る err = Marshal.GetLastWin32Error()

  • VB6 APIを使った文字印刷について

    VB6でAPI(TextOut)を使って印刷する必要があるのですが、インターネットで調べたらサンプルがあってそれを参考にさせてもらおうと思っています。 ただ、当方としては、印刷位置と印刷文字サイズをmmで指定したく、色々試しているのですがうまくいきません。お分かりになる方どこがおかしいかご教示願えないでしょうか? サンプルのソースコードを以下に張っておきます。formにCommandボタンを一つ張ってください。 Option Explicit Dim FX As Integer 'フォントの横サイズ Dim FY As Integer 'フォントの縦サイズ Dim cx As Long '表示X座標 Dim cy As Long '表示Y座標 Private Const DEFAULT_CHARSET = 1 Private Const OUT_DEFAULT_PRECIS = 0 Private Const DEFAULT_QUALITY = 0 Private Const DEFAULT_PITCH = 0 Private Const FF_DONTCARE = 0 Private Const LF_FACESIZE = 32 Private Type Size cx As Long cy As Long End Type Private Type LOGFONT lfHeight As Long lfWidth As Long lfEscapement As Long lfOrientation As Long lfWeight As Long lfItalic As Byte lfUnderline As Byte lfStrikeOut As Byte lfCharSet As Byte lfOutPrecision As Byte lfClipPrecision As Byte lfQuality As Byte lfPitchAndFamily As Byte lfFaceName(LF_FACESIZE) As Byte End Type Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long Private Sub Command1_Click() Printer.Print "" '文字印刷位置縦0mm 文字幅6mm、文字高6mmで印刷 FX = 6: FY = 6 cx = 0: cy = 0 PrintText "testてすと1" '文字印刷位置縦50mm 文字幅6mm、文字高12mmで印刷 FX = 6: FY = 12 cx = 0: cy = 50 PrintText "testてすと2" '縦倍角 '文字印刷位置縦200mm 文字幅12mm、文字高6mmで印刷 FX = 12: FY = 6 cx = 0: cy = 100 PrintText "testてすと3" '横倍角 Printer.EndDoc End Sub Sub PrintText(text As String) Dim LF As LOGFONT Dim IX As Integer Dim TempByteArray() As Byte Dim ByteArrayLimit As Long Dim OldFT As Long Dim NewFT As Long Dim rtn As Long Dim hdc As Long Dim PX As Long Dim PY As Long hdc = Printer.hdc '↓(1)ここで文字印刷位置をmmかTwipに変換しているつもりなのですが・・・ PX = Printer.ScaleX(cx, vbMillimeters, vbTwips) PY = Printer.ScaleY(cy, vbMillimeters, vbTwips) With LF .lfEscapement = 0 '文字の回転角度(角度*10) '↓(2)ここで文字サイズをmmかTwipに変換しているつもりなのですが・・・ .lfHeight = Printer.ScaleY(FY, vbMillimeters, vbTwips) '文字の高さ .lfWidth = Printer.ScaleX(FX, vbMillimeters, vbTwips) '文字の幅 .lfWeight = 400 '文字の太さ .lfItalic = False '斜体 .lfUnderline = False '下線 .lfStrikeOut = False '取り消し線 .lfCharSet = DEFAULT_CHARSET .lfOutPrecision = OUT_DEFAULT_PRECIS .lfClipPrecision = OUT_DEFAULT_PRECIS .lfQuality = DEFAULT_QUALITY .lfPitchAndFamily = DEFAULT_PITCH Or FF_DONTCARE TempByteArray = StrConv("MS ゴシック", vbFromUnicode) ByteArrayLimit = UBound(TempByteArray) For IX = 0 To ByteArrayLimit .lfFaceName(IX) = TempByteArray(IX) Next End With NewFT = CreateFontIndirect(LF) OldFT = SelectObject(hdc, NewFT) TextOut hdc, PX, PY, text, LenB(StrConv(text, vbFromUnicode)) rtn = SelectObject(hdc, OldFT) rtn = DeleteObject(NewFT) End Sub 以上よろしくおねがいします。

  • Workbook

    次のプログラムをExcelのWorkbookで開くやり方がよくわかりません。 どうやってやるのか教えていただけないでしょうか? Option Explicit Const ALIVE As Integer = 1 Const DEAD As Integer = 0 Const BORN As Integer = 3 Const LIFE As Integer = 2 Const SIZE As Integer = 20 Const Tmax As Integer = 100 Dim C(SIZE, SIZE) As Integer Dim Xrange As Variant Private Sub LifeGame() Dim InitRate As Single Dim T As Integer Dim I As Integer, J As Integer Randomize Xrange = Range("A1:T20") InitRate = 0.5 For I = 1 To SIZE For J = 1 To SIZE If Rnd() < InitRate Then C(I, J) = ALIVE Else C(I, J) = DEAD End If Next J Next I For T = 1 To Tmax For I = 1 To SIZE For J = 1 To SIZE If C(I, J) = ALIVE Then Xrange(I, J) = "■" Else Xrange(I, J) = "" End If Next J Next I Range("A1:T20") = Xrange For I = 1 To SIZE For J = 1 To SIZE C(I, J) = Cnext(I, J) Next J Next I Next T End Sub Function Cnext(I As Integer, J As Integer) As Integer Dim xi As Integer Dim xj As Integer Dim xsum As Integer For xi = I - 1 To I + 1 For xj = J - 1 To J + 1 If (xi > 0 And xi <= SIZE) _ And (xj > 0 And xj <= SIZE) Then If Not (xi = I And xj = J) Then If C(xi, xj) = ALIVE Then xsum = xsum + 1 End If End If End If Next Next Select Case xsum Case BORN Cnext = ALIVE Case LIFE Cnext = C(I, J) Case Else Cnext = DEAD End Select End Function Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Call LifeGame End Sub

  • 「VB4.0の「LSet」と同等の機能をVB2008で実行するには?」のリストを修正します

    「VB4.0の「LSet」と同等の機能をVB2008で実行するには?」の質問で リストに間違いがあったので訂正します。 Public Type TpstndefをPublic Type Tpkyokudef VB2008の練習のために、VB4.0のコードをVB2008にコンバージョンしています。 VB4.0の「LSet」がどうしてもコンバージョンできません。 LSet 以外はVB2008で機能がありました。 なにか方法はないでしょうか。 リストをコピーします。 Public Type Tpkyokudef equip As Integer stn_no As Integer stn_class As Integer line_no As Integer stn_kind As Integer End Type Dim kdata As Tpkyokudef Dim rbuf As buf1K    ・   省略    ・ Get #fno, seeksize, rbuf LSet kdata = rbuf

専門家に質問してみよう