Microsoft Access 掲示板

高さが可変のテキストボックスの上下中央に文字を配置したい / 6

27 コメント
views
4 フォロー
6
亞紀姐 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

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

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

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

通報 ...