Microsoft Access 掲示板

フォーマット時イベントで関係する設定を計算してレイアウトを決定します。印刷時イベントでは、それを出力するだけですので、印刷時ではレイアウトは変更できません。

印刷時拡張後の高さは印刷時にしか取得できない、しかし、レイアウト変更は印刷時ではできない、レイアウトの設定には印刷時拡張後の高さが必要である、
ということで普通の方法では不可能な状態です。

そこで利用するのが、下記で紹介している総ページを取得するときのダミーのフォーマット時イベントです。

レポートのイベントの発生メカニズムの研究 その２ - hatena chips

総ページを取得するために最終レコードまでダミーのフォーマット時イベントを発生させる。
その後、先頭に戻って、本番のフォーマット時、印刷時イベントを発生させて実際に出力する。
という動作になってます。

これを利用して、下記のような処理にします。
ダミーのフォーマット時に配列に各行毎の印刷時拡張後の高さを格納しておく。
本番のフォーマット時に配列から印刷時拡張後の高さを取得してそれをもとにレイアウトを設定する。

レポート上のどこでもいいので、総ページ数を取得するためにコントロールソースが=[Pages]のテキストボックスを配置しておく。(すでに総ページ数を表示するためのテキストボックスがあるなら不要)

下記のような感じでレイアウトを設定できます。

Option Compare Database
Option Explicit
Dim h() As Long '印刷時拡張後の高さを格納する配列
'開くとき
Private Sub Report_Open(Cancel As Integer)
    Redim h(1 to Me.Recordset.RecordCount) '配列のサイズをレコード数分に設定
End Sub
 
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
    If Me.Pages = 0 Then 'ダミーのフォーマット時はPages=0
        h(Me.CurrentRecord) = Me.詳細.Height 
    Else
        Dim exHeight As Long
        exHeight = h(Me.CurrentRecord)
        'exHeightに拡張後の高さが格納されているのでそれを利用してレイアウトを設定

    End If
End If

ありがとうございます。
レポート上には
「=Int(([番号]/6)+0.9) & "頁／" & Int((Count([ビル名])/6)+0.9) & "頁中"」
というテキストボックスがあるのですが、多分それだとうまく作動しないのでは、と思い
「=[Pages]」
という非可視のテキストボックスを作りました。

コードに関しては、現状のコードに追加する形で

Option Compare Database
Option Explicit
'Dim d As Object    ' Dictionary オブジェクト用変数

Const A4Height As Long = 21 * 567   'A4用紙の高さ=29.7cm、横の場合=21.0cm、1cm=567twips
Dim PageHeight As Long
Dim h() As Long '印刷時拡張後の高さを格納する配列

'開くとき
Private Sub Report_Open(Cancel As Integer)
'    Set d = CreateObject("Scripting.Dictionary")
'印刷可能領域下辺のページ上端からの高さを取得
    On Error Resume Next
    PageHeight = A4Height - Me.Printer.BottomMargin
    PageHeight = PageHeight - Me.Section(acPageFooter).Height

    ReDim h(1 To Me.Recordset.RecordCount) '配列のサイズをレコード数分に設定
End Sub

Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
    Dim j As Integer
    Dim i As Integer

    For j = 51 To 57
        Me.DrawStyle = 0
        Me.Line (Me("L" & j).Left, 0)-(Me("L" & j).Left, 144000)
    Next

     For i = 2 To 12
        Me.DrawStyle = 2
        Me.Line (Me("L" & i).Left, 0)-(Me("L" & i).Left, 144000)
     Next

    WordWrapOff Me.NAS用, Me.txtFld1

Me.NAS用.FELineBreak = False
Me.txtFld1.FELineBreak = False

    If Me.Pages = 0 Then 'ダミーのフォーマット時はPages=0
        h(Me.CurrentRecord) = Me.詳細.Height
    Else
        Dim exHeight As Long
        exHeight = h(Me.CurrentRecord)
        'exHeightに拡張後の高さが格納されているのでそれを利用してレイアウトを設定

    End If
End Sub

としました。（最後のEnd Ifは対応するIfがない、としてエラーになったため削りました）

しかし、「h(Me.CurrentRecord) = Me.詳細.Height」のところで「インデックスが有効範囲にない」と言われて見ることが出来ませんでした。

何か他に直さなくてはいけないところがあるのでしょうか？
よろしくお願いします。

（最後のEnd Ifは対応するIfがない、としてエラーになったため削りました）

削らないでください。必要です。
それでエラーになるなら、提示のコードが実際のものとは異なっていると思います。
実際のコードをコピーして貼り付けてください。

コードはマークダウンのコードブロックにいれてください。
詳細は下記を参照ください。

Microsoft Access 掲示板 の使い方 Microsoft Access 掲示板 - zawazawa

Me.Recordset.RecordCountはレポートでは使えないようですので、下記に修正してください。
まずレポートヘッダーかレポートフッターにテキストボックスを配置して下記のように設定してください。

名前 件数
コントロールソース　=Count(*)
可視 いいえ

   'ReDim h(1 To Me.Recordset.RecordCount) '配列のサイズをレコード数分に設定
   '上記を下記に修正
   ReDim h(1 To Me.件数) '配列のサイズをレコード数分に設定

あと、下記の部分はそちらのレポートの設定にあわせて、ご希望のレイアウトになるようにコードを記述してください。こちらではそちらのレポートの設定は分かりませんので。

  'exHeightに拡張後の高さが格納されているのでそれを利用してレイアウトを設定

ありがとうございます。
返答が遅くなりすみません。

上記のように変更し、以下のコード（全部コピーしました）にしましたが、やはり同じところで止まってしまいます。
（＞しかし、「h(Me.CurrentRecord) = Me.詳細.Height」のところで「インデックスが有効範囲にない」と言われて見ることが出来ませんでした。）
Me.CurrentRecord　にマウスオーバーすると「1」と表示され
Me.詳細.Height　にマウスオーバーすると「798」と表示され
h　にマウスオーバーすると「h(Me.CurrentRecord) = ＜インデックスが有効範囲にありません＞」と表示されます。

Option Compare Database
Option Explicit

Const A4Height As Long = 21 * 567   'A4用紙の高さ=29.7cm、横の場合=21.0cm、1cm=567twips
Dim PageHeight As Long
Dim h() As Long '印刷時拡張後の高さを格納する配列

'開くとき
Private Sub Report_Open(Cancel As Integer)
'    Set d = CreateObject("Scripting.Dictionary")
'印刷可能領域下辺のページ上端からの高さを取得
    On Error Resume Next
    PageHeight = A4Height - Me.Printer.BottomMargin
    PageHeight = PageHeight - Me.Section(acPageFooter).Height

    ReDim h(1 To Me.件数) '配列のサイズをレコード数分に設定

End Sub

Private Sub Report_Page()
On Error GoTo Err_Report_Page

Dim LineTop As Long, LineLeft As Long, LineWidth As Long, LineBottom As Long, SecHight As Long
Dim i As Integer

    With Me
        LineTop = .ページヘッダーセクション.Height + .グループヘッダー0.Height
        LineLeft = .直線355.Left
        LineWidth = .直線372.Width
        LineBottom = 21 * 567 - Me.Printer.BottomMargin - Me.Section(acPageFooter).Height
        SecHight = Me.詳細.Height
        '太線 の太さをここで指定
        .DrawWidth = 12
        
        '外枠
         Me.Line (LineLeft, LineTop - .直線355.Height)-(LineLeft + LineWidth - 10, ((21 - 0.5 - 3.998) * 567) - 90), , B
         Me.Line (LineLeft, ((21 - 0.5 - 3.998) * 567) - 95)-(LineLeft + LineWidth - 10, ((21 - 0.5 - 0.5) * 567) - 300 - .直線385.Height), , B

    End With

Exit Sub
Exit_Report_Page:

    Exit Sub

Err_Report_Page:

Select Case Err.Number
Case 2501
MsgBox "印刷するデータは有りません。", vbOKOnly
Resume Exit_Report_Page

Case Else
MsgBox Err.Number & " : " & Err.Discription
Resume Exit_Report_Page

End Select

End Sub
Private Sub グループフッター2_Format(Cancel As Integer, FormatCount As Integer)
On Error GoTo Err_Report_Page
    
    If Me.Top + Me.グループフッター2.Height <= PageHeight Then
        Me.NextRecord = False
        If FormatCount > 10 Then Me.NextRecord = True
        '↑想定外の動作で無限ループになった場合でも、10回で止まる
    Else
        Cancel = True
    End If
    
Exit Sub
Exit_Report_Page:

    Exit Sub

Err_Report_Page:

Select Case Err.Number
Case 2501
MsgBox "印刷するデータは有りません。", vbOKOnly
Resume Exit_Report_Page

Case Else
MsgBox Err.Number & " : " & Err.Discription
Resume Exit_Report_Page

End Select

End Sub
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
    Dim j As Integer
    Dim i As Integer

    For j = 51 To 57
        Me.DrawStyle = 0
        Me.Line (Me("L" & j).Left, 0)-(Me("L" & j).Left, 144000)
    Next
        
     For i = 2 To 12
        Me.DrawStyle = 2
        Me.Line (Me("L" & i).Left, 0)-(Me("L" & i).Left, 144000)
     Next

    WordWrapOff Me.NAS用, Me.txtFld1
    
Me.NAS用.FELineBreak = False
Me.txtFld1.FELineBreak = False
    
    If Me.Pages = 0 Then 'ダミーのフォーマット時はPages=0
        h(Me.CurrentRecord) = Me.詳細.Height
    Else
        Dim exHeight As Long
        exHeight = h(Me.CurrentRecord)
        'exHeightに拡張後の高さが格納されているのでそれを利用してレイアウトを設定

    End If

End Sub
Private Sub ビル名ヘッダーセクション_Format(Cancel As Integer, FormatCount As Integer)
    If Me.Pages > 0 Then
        Me.txtTo = d(Me.Page) & "番"
    End If
End Sub
Private Sub ビル名フッターセクション_Format(Cancel As Integer, FormatCount As Integer)
    If Me.Pages = 0 Then
        d(Me.Page) = Me.番号
    End If
End Sub
Private Sub Report_NoData(Cancel As Integer)

  MsgBox "対象物件がないか、住所が入力されていません"
  Cancel = True
  MsgBox "NAS用メンテナンス計画表を閉じます。"

End Sub

あと、
＞あと、下記の部分はそちらのレポートの設定にあわせて、ご希望のレイアウトになるようにコードを記述してください。こちらではそちらのレポートの設定は分かりませんので。
の部分なのですが、すみません。意味がよくわからなかったので一旦そのままにしてあります。

まずは表示ができるようにと思い、エラーを消したいのですが
まだ誤っている部分があるかを教えていただけると助かります。
尋ねてばかりですみません。

よろしくお願いいたします。

Report_Open時では件数は取得できませんでした。

Report_Open内の下記のコードを削除して、

    ReDim h(1 To Me.件数) '配列のサイズをレコード数分に設定

レポートヘッダーのフォーマット時のイベントプロシージャを下記のように記述してください。

Private Sub レポートヘッダー_Format(Cancel As Integer, FormatCount As Integer)
    If Me.Pages = 0 Then
        ReDim h(1 To Me.件数) '配列のサイズをレコード数分に設定
    End If
End Sub

＞あと、下記の部分はそちらのレポートの設定にあわせて、ご希望のレイアウトになるようにコードを記述してください。こちらではそちらのレポートの設定は分かりませんので。
の部分なのですが、すみません。意味がよくわからなかったので一旦そのままにしてあります。

印刷時拡張後のセクションを高さを取得する方法を回答してます。
取得した高さを利用して、ご希望のレイアウトに設定するコードは亞紀姐さんが自分で考えて書いてくださいということです。

やはり同じところで同じエラーが出ます。

何か提示し足りない情報があるということですよね…
コードはこれが全部なので足りないとなると、元になるクエリとかレポートの設定なのでしょうか…

それとももう諦めたほうが良いのでしょうか…

レポートヘッダーを使っていない、または、レポートヘッダーのフォーマット時に[イベント プロシージャ]が設定されていないとか？

ちょっと試してみましたがReDim h(1 To Me.件数)はレポートの読み込み時（Report_Load）にやるのがオススメですかね

ありがとうございます！
コードは書かれていたのですが、まさに
＞レポートヘッダーを使っていない、または、レポートヘッダーのフォーマット時に[イベント プロシージャ]が設定されていないとか？
これでした！
コードに書いたらそこに記載されると思い込んでいました。失礼しました…

これで無事表示できるようになりました。

しかし、やっぱり元々希望している
【行の高さに係わらず、上下中央にテキストを配置】
ができません…（画像参照）

なお、hirotonさまの仰る
＞ちょっと試してみましたがReDim h(1 To Me.件数)はレポートの読み込み時（Report_Load）にやるのがオススメですかね
も、hatenaさまの仰るレポートヘッダーのフォーマット時もどちらも試しましたが結果は同じでした。

Report_Loadならレポートヘッダがなくても動作するのでそれがいいですね。

上下中央に配置するテキストが画像のように金額だったり、「〇」だけなら、
印刷時イベントでPrintメソッドで出力する方法がいいですね。
これなら配列に高さを格納するコードは不要です。

Report.Print メソッド (Access) | Microsoft Learn

印刷時拡張で2行以上になる場合とかは使えないですし、ユニコード非対応なのでS-Shiftにない文字があると文字化けするのでその場合は、使えませんが。

下記はテキストボックス１のテキストを上下中央に表示します。

Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
    
    With Me.テキストボックス１
        .Visible = False
        Me.FontSize = .FontSize
        Me.FontName = .FontName
        Me.CurrentX = .Left
        Me.CurrentY = (Me.Height / 2) - (Me.TextHeight(.Value) / 2)
        Me.Print .Value
    End With
    
End Sub

いろいろ試してみました
Formatイベント/Printイベントで出来ること/できないことできないことむずかしいですねぇ

「Ctl1月」テキストボックスは「自社用」テキストボックスと同時に選択してレイアウト→表形式にしておきます

Dim h As Long

Private Sub Report_Load()
    h = Me!Ctl1月.Height
End Sub

Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
    Me!Ctl1月.TopMargin = (Me!自社用.Height - h) / 2
End Sub

hは固定値なので直接記述してもいいかなとも思います
例）

Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
    Me!Ctl1月.TopMargin = (Me!自社用.Height - 270) / 2 '//270は元のMe!Ctl1月.height
End Sub

Printイベントでは多くのプロパティが変更できません
そんな中でも余白のプロパティは変更できるようです

高さのプロパティは変更できないので、印刷時拡張が設定されたテキストボックスと表形式のレイアウトを組んでおくことで高さが揃うようにします

印刷時拡張後の高さは印刷時拡張プロパティを「はい」にしたコントロールから取得できます（詳細セクションの高さでは取得できませんでした）

Printイベントでは多くのプロパティが変更できません
そんな中でも余白のプロパティは変更できるようです

高さのプロパティは変更できないので、印刷時拡張が設定されたテキストボックスと表形式のレイアウトを組んでおくことで高さが揃うようにします

おお！！素晴らしいアイデアですね。
印刷時でも余白は変更できるとは思いもよりませんでした。
表形式のレイアウトで高さを揃えるというのも思いつきませんでした。

印刷時拡張後の高さは印刷時拡張プロパティを「はい」にしたコントロールから取得できます（詳細セクションの高さでは取得できませんでした）

これには関しては、Me.Height でカレントセクションの印刷時拡張時の高さを取得できます。

色々試したのですがhirotonさまのコード、短くてできればそれにしたかったのですが、真ん中にはなってくれず…
hatenaさまの以下の上下中央（レス番号12）コードを元に上下中央にしたいテキストボックス全てに書く方式になりそうです。
【参考コード】

Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
    
    With Me.テキストボックス１
        .Visible = False
        Me.FontSize = .FontSize
        Me.FontName = .FontName
        Me.CurrentX = .Left
        Me.CurrentY = (Me.Height / 2) - (Me.TextHeight(.Value) / 2)
        Me.Print .Value
    End With
    
End Sub

【現状のコード】

Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
    
    With Me.請受金額月額
        .Visible = False
        .Format = "Currency"
        Me.FontSize = .FontSize
        Me.FontName = .FontName
        Me.CurrentX = .Left 
        Me.CurrentY = (Me.Height / 2) - (Me.TextHeight(.Value) / 2)
        Me.Print .Value
    End With
     
    If IsNull(Me.txt_1月) = False Then
     If IsNull(Me.txt_1月) = True Then Me.txt_1月 = Me.txt_1月
       With Me.txt_1月
        .Visible = False
        Me.FontSize = .FontSize
        Me.FontName = .FontName
        Me.CurrentX = .Left + 26 '//26は位置調整のための数字
        Me.CurrentY = (Me.Height / 2) - (Me.TextHeight(.Value) / 2)
        Me.Print .Value
       End With
    End If

End Sub

ただ、以下のことが出来ずに半日悩んでいました。

適当にサンプルで作ったのはこんな感じですね

オブジェクトの表示にはいろんな「隙間」があるので影響あるものを見つけて適切に調整する必要はあると思います

1.数字を桁区切り＋￥がついた通貨型で表示したい
2.指定した場所から左揃えではなく右揃えで表示したい

テキストボックスは非表示にして、Printメソッドで表示してますので、そちらの方を修正する必要があります。

    Dim s As String
    With Me.請受金額月額
        .Visible = False
        Me.FontSize = .FontSize
        Me.FontName = .FontName
        s = Format(.Value, .Format) 'テキストボックスの書式プロパティで書式化
        Me.CurrentX = .Left + .Width - Me.TextWidth(s) '左寄せ
        Me.CurrentY = (Me.Height / 2) - (Me.TextHeight(.Value) / 2)
        Me.Print S
    End With

3.同じような書式設定にしたいものが複数あるが、同じコードを繰り返す以外のやり方はないのか？

テキストボックス名が、
txt_1月, txt_2月 ・・・・txt_12月
だとして、
Controlsで文字列のテキストボックス名でアクセスできますので、
それを利用してループ処理します。

    Dim i As Long
    For i = 1 to 12
        With Me.Controls("txt_" & i & "月")
            .Visible = False
            If Not IsNull(.Value) Then
                Me.FontSize = .FontSize
                Me.FontName = .FontName
                Me.CurrentX = .Left + 26 '//26は位置調整のための数字
                Me.CurrentY = (Me.Height / 2) - (Me.TextHeight(.Value) / 2)
                Me.Print .Value
            End If
       End With
    Next

ありがとうございます。

1.数字を桁区切り＋￥がついた通貨型で表示したい

テキストボックスは非表示にして、Printメソッドで表示してますので、そちらの方を修正する必要があります。

1.の通貨型なのですが
のような設定なのですが（日本円設定です）

になってしまいます。
他に設定しなくてはいけない部分があるのでしょうか？

2.指定した場所から左揃えではなく右揃えで表示したい

2.の右揃えは出来ました。
ありがとうございます。

3.同じような書式設定にしたいものが複数あるが、同じコードを繰り返す以外のやり方はないのか？

3.のこちらも出来ました。
ありがとうございます。

追加の質問で申し訳ないのですが

4.詳細セクションとグループフッターセクションのつなぎ目の部分で縦の罫線が微妙にずれます（画像の右縦線参照）
左位置は表示されている小数点第3位まで同じです。
しかし、設定上プロパティの左位置に数字を入力しても丸められているのか飛び飛びになるので実際にずれているのかもしれません。
これを画像の左縦線の様にまっすぐあわせるのは難しいのでしょうか？

5.画像の「6」が入力されている行が詳細セクションの（このページでの）最終行でその下がグループフッターセクションで作った空行なのですが、詳細セクションとグループフッターセクションの間に隙間ができてしまいます。
縦線の長さは全て一致して、セクションの高さも最小値（恐らく縦線の長さ+横下線の太さ分）になっていますがそれでも隙間が空きます。
また、縦線だけあえて少し長くしてみると

一番下の空白部分に線がはみ出します（当たり前）
一番下にはみ出さず、セクション間に隙間を作らない方法は何かありませんでしょうか？


尚、補足ですが詳細セクションとグループヘッダーセクションやグループフッターセクションページフッターセクションとの間には太線が引かれているため隙間があるのかもしれませんが隠れてしまい見た目上隙間は無いようになっています。

段々とずれてきてしまいすみません。
あと少しだと思うのですが、もう少しよろしくお願いします。

不思議な現象ですねぇってことで書式「通貨」に設定したテキストボックスでテストをしてみました

Dim s As String
s = Format(Me!テキスト3, Me!テキスト3.Format)
Debug.Print s; Asc(s); AscW(s); Me!テキスト3.Format

s = "\30"
Debug.Print s; Asc(s); AscW(s)

結果

\30 92  165 Currency
\30 92  92 

書式「通貨(Currency)」で使われる円記号はUnicodeのA5のようです。PrintメソッドがUnicodeに対応していないので文字化けするとかじゃないですかねぇ

文字コードの変換を入れてあげると円記号が表示できます

s = Format(.Value, .Format) 'テキストボックスの書式プロパティで書式化
s = StrConv(s, vbNarrow) 'Printメソッドでの描画用に変換

縦罫線に関しては前の質問でもページフォーマット時(Report_Page)でやればいいのでは？と回答してますが、うまくいかなかったんでしょうか？

通貨型、無事にできました！
ありがとうございます！！

縦罫線に関しては前の質問でもページフォーマット時(Report_Page)でやればいいのでは？と回答してますが、うまくいかなかったんでしょうか？

失礼しました。
何かで作業途中になっていました…

以下の様に修正しました。

Private Sub Report_Page()
On Error GoTo Err_Report_Page

Dim LineTop As Long, LineLeft As Long, LineWidth As Long, LineBottom As Long, SecHight As Long
Dim i As Integer

    With Me
        LineTop = .ページヘッダーセクション.Height + .グループヘッダー0.Height
        LineLeft = .直線355.Left
        LineWidth = .直線372.Width
        LineBottom = 21 * 567 - Me.Printer.BottomMargin - Me.Section(acPageFooter).Height
        SecHight = Me.詳細.Height

        '縦罫線 内側
        For i = 2 To 19
            If i = 8 Then .DrawStyle = 2
            If i = 19 Then .DrawStyle = 0
           Me.Line (Me("lbl" & i).Left, LineTop)-(Me("lbl" & i).Left, ((21 - 0.5 - 3.998) * 567) - 90)
        Next

        '太線 の太さをここで指定
        .DrawWidth = 12
        
        '外枠
         Me.Line (LineLeft, LineTop - .直線355.Height)-(LineLeft + LineWidth - 10, ((21 - 0.5 - 3.998) * 567) - 90), , B
         Me.Line (LineLeft, ((21 - 0.5 - 3.998) * 567) - 95)-(LineLeft + LineWidth - 10, ((21 - 0.5 - 0.5) * 567) - 300 - .直線385.Height), , B

    End With

Exit Sub
Exit_Report_Page:
    Exit Sub

Err_Report_Page:
Select Case Err.Number
Case 2501
MsgBox "印刷するデータは有りません。", vbOKOnly
Resume Exit_Report_Page

Case Else
MsgBox Err.Number & " : " & Err.Discription
Resume Exit_Report_Page

End Select
End Sub

また、

Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
    Dim j As Integer
    Dim i As Integer

    For j = 51 To 57
        Me.DrawStyle = 0
        Me.Line (Me("L" & j).Left, 0)-(Me("L" & j).Left, 144000)
    Next
        
'     For i = 2 To 12
'        Me.DrawStyle = 2
'        Me.Line (Me("L" & i).Left, 0)-(Me("L" & i).Left, 144000)
'     Next

    WordWrapOff Me.NAS用, Me.txtFld1
    
Me.NAS用.FELineBreak = False
Me.txtFld1.FELineBreak = False

End Sub

とし、詳細セクションのフォーマットイベントにあった罫線スタイルの指定をなくしたところうまくいきました。
（前はここがダブってしまっていて、線がきれいに点線になっていませんでした。）

大変失礼しました。

以上にて無事に担当に提出することが出来ました。
本当に長々とありがとうございました。