亞紀姐
2024/01/04 (木) 13:56:42
6b68c@61731
ありがとうございます。
返答が遅くなりすみません。
上記のように変更し、以下のコード(全部コピーしました)にしましたが、やはり同じところで止まってしまいます。
(>しかし、「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
あと、
>あと、下記の部分はそちらのレポートの設定にあわせて、ご希望のレイアウトになるようにコードを記述してください。こちらではそちらのレポートの設定は分かりませんので。
の部分なのですが、すみません。意味がよくわからなかったので一旦そのままにしてあります。
まずは表示ができるようにと思い、エラーを消したいのですが
まだ誤っている部分があるかを教えていただけると助かります。
尋ねてばかりですみません。
よろしくお願いいたします。
通報 ...