Access (VBA)

Access VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 8 : Access 2013)
前任作成の印刷ツールがうまく作動しない
投稿日時: 18/04/30 15:06:04
投稿者: 2011wing

ACCESS VBAでご質問です。顧客情報を印刷発送するためのツールがあります。
 様式が一部変更になったので差し替えたのですが、正しく情報が転記されず困っております。
大変長い構文の為全部を載せる事ができず、ここら辺を見直してみるといいよといったアドバイスがお伺いできればと思っております
 
'エクセルマスタ開く
Set xlsApp = CreateObject("Excel.Application")
 xlsApp.Workbooks.Open strMasterFileName
 Set myBook = xlsApp.ActiveWorkbook
 
 '★開発中のため表示
xlsApp.WindowState = xlMinimized 'Excel最小化(改ページ設定がうまくいかないのでコメント)
xlsApp.Visible = True 'Excelを見えるようにしないと改ページ設定がうまくいかないかも?
 
Set mySHT = myBook.Sheets(conSHTName)
 ''' mySHT.Select '2018/2/1エラー1004のため入れてみたがコメントでも動くのでコメントとする
''' mySHT.Activate '2018/2/1エラー1004のため入れてみたがコメントでも動くのでコメントとする
 
xlsApp.Calculation = xlCalculationManual '自動計算停止
 
'初期化
lngRcCnt = 0
 
 Do Until RSout.EOF
 
 lngRcCnt = lngRcCnt + 1
 
 If strDEBUG = "debug" Then Debug.Print "ご契約内容一覧作成:(" & lngRcCnt & ") ID=" & RSout![ID]
 If strDEBUG = "debug" Then Debug.Print "ご契約内容一覧作成:(" & lngRcCnt & ") BP番号=" & RSout![6_ビジネスパートナー番号]
 
If lngRcCnt = 1 Then
 
 'ご契約内容一覧 表題(Excel)作成
If Not ご契約内容一覧_表題(mySHT, lngMaxRcCnt) Then
 'ご契約内容一覧(表題)が作成できないときは、処理終了
GoTo ERR_END
 End If
 
 End If
 
 'ご契約内容一覧 明細(Excel)作成
If Not ご契約内容一覧_明細(mySHT, lngRcCnt) Then
 'ご契約内容一覧(明細)が作成できないときは、処理終了
GoTo ERR_END
 End If
 
 RSout.MoveNext
 
 Loop
 
 xlsApp.Calculation = xlCalculationAutomatic '自動計算再開
 
'名前を付けて保存
xlsApp.DisplayAlerts = False
 myBook.SaveAs FileName:=strOutFileName契約内容一覧
xlsApp.DisplayAlerts = True
 
 'エクセルの終了
xlsApp.Quit
 
 'ご契約内容一覧フルパス更新
Call TW02_フルパス更新(strビジネスパートナー番号, strOutFileName契約内容一覧, 2)
 
 NORMAL_END:
 
 Set mySHT = Nothing
 Set myBook = Nothing
 Set xlsApp = Nothing
 
 RSout.Close: Set RSout = Nothing
 CN2.Close: Set CN2 = Nothing
 
 Exit Function
 
 ERR_END:
 
 'マスタは保存しないで閉じる
myBook.Close SaveChanges:=False
 
ご契約内容一覧作成 = False
 
 GoTo NORMAL_END
 
 'エラー処理
ErrHandler:
 
 'マスタは保存しないで閉じる
myBook.Close SaveChanges:=False
 
 If Err Then
 MsgBox ("ご契約内容一覧作成" & vbCrLf & Err.Number & vbCrLf & Err.Description & vbCrLf & Err.Source)
ご契約内容一覧作成 = False
 End If
 
 GoTo NORMAL_END
 
 End Function
 
 Function ご契約内容一覧_表題(prSHT As Object, prMaxRcCnt As Long)
 
 Dim int口数Page As Long
 Dim int改行row As Long
 
 Dim lngRowPaste As Long
 Dim i As Long
 
 On Error GoTo ErrHandler
 
ご契約内容一覧_表題 = True
 
 If strDEBUG = "debug" Then Debug.Print "ご契約内容一覧_表題: prMaxRcCnt=" & prMaxRcCnt
 
 If strDEBUG = "debug" Then Debug.Print "ご契約内容一覧_表題: ID=" & RSout![ID]
 If strDEBUG = "debug" Then Debug.Print "ご契約内容一覧_表題: BP番号=" & RSout![6_ビジネスパートナー番号]
 
 ' With prBook.Sheets(conSHTName) '対象シート
With prSHT
 
 'Eビジネスパートナー番号
.Range("A13").Value = "ビジネスパートナー番号:" & Nz(RSout![6_ビジネスパートナー番号], "")
 
 'F口数
'.Range("A17").Value = Val(RSout![7_口数])
If IsNumeric(RSout![7_口数]) Then
 .Range("H14").Value = Val(RSout![7_口数])
Else
 .Range("H14").Value = "-"
End If
 
 
 '口数分の明細行をコピーする
lngRowPaste = 15 '明細「1」の先頭行を初期値に設定
For i = 2 To prMaxRcCnt
 lngRowPaste = lngRowPaste + 9
 .Rows("15:23").Copy .Rows(lngRowPaste)
 .Range("A" & lngRowPaste) = i
 Next i
 
'印刷範囲を設定
.PageSetup.PrintArea = "A1:BA" & (lngRowPaste + 8)
 
 If prMaxRcCnt >= 6 Then
 
 '1P目と2P目の改ページを追加(水平方向)
.HPageBreaks.Add Before:=.Range("A65")
 
 '全明細数から1P目の5明細分を差し引き、2P目以降印刷される7明細が何ページあるか算出
int口数Page = ((prMaxRcCnt - 5) / 7) + 0.5
 
 If strDEBUG = "debug" Then Debug.Print "int口数page = " & int口数Page
 
 '改ページ設定行を算出 計算式 2P目の開始行(65行目)に対象ページ×63行(7明細)を足す
'ただし、印刷範囲内の場合のみ改行設定を行う
 
For i = 1 To int口数Page
 
 '1P目は64行(5明細) 2P目以降は63行(7明細)基準
int改行row = 65 + (i * 63)
 
 If int改行row <= (lngRowPaste + 8) Then
 If strDEBUG = "debug" Then Debug.Print "Hpagebreaks.add = A" & int改行row
 .HPageBreaks.Add Before:=.Range("A" & int改行row)
 
 End If
 
 Next i
 
 End If
 
 End With
 
 NORMAL_END:
 
 Exit Function
 
 'エラー処理
ErrHandler:
 
 If Err Then
 '作成エラー
strMSG_TW02 = "(ご契約内容一覧 表題)"
Call TW02_データチェック更新(RSout![6_ビジネスパートナー番号], 7)
 
 MsgBox ("ご契約内容一覧_表題" & vbCrLf & Err.Number & vbCrLf & Err.Description & vbCrLf & Err.Source)
ご契約内容一覧_表題 = False
 End If
 
 GoTo NORMAL_END
 
 End Function
 
 Function ご契約内容一覧_明細(prSHT As Object, prRecCnt As Long)
 
 Dim lngRowPasteST As Long
 Dim lngRowPaste As Long
 
 Dim str番号 As String
 Dim str日付 As String
 Dim datご契約満了予定日 As Date
 
 On Error GoTo ErrHandler
 
ご契約内容一覧_明細 = True
 
 If strDEBUG = "debug" Then Debug.Print "ご契約内容一覧_明細: prRecCnt=" & prRecCnt
 If strDEBUG = "debug" Then Debug.Print "ご契約内容一覧_明細: ID=" & RSout![ID]
 If strDEBUG = "debug" Then Debug.Print "ご契約内容一覧_明細: BP番号=" & RSout![6_ビジネスパートナー番号]
If strDEBUG = "debug" And RSout![6_ビジネスパートナー番号] = "1000000040" Then
 Debug.Print "---------------ここからチェック"
End If
 lngRowPasteST = 15 + (9 * (prRecCnt - 1)) '明細行の設定 明細「1」の開始行=15 + (明細9行 × (出力する明細No-1))
 If strDEBUG = "debug" Then Debug.Print "ご契約内容一覧_明細: lngRowPasteST=" & lngRowPasteST
 
 ' With prBook.Sheets(conSHTName) '対象シート
 
With prSHT
 'Nご契約名義 (第一名義)
lngRowPaste = lngRowPasteST + 1
 .Range("B" & lngRowPaste).Value = Nz(RSout![15_ご契約名義(第一名義)], "")
If strDEBUG = "debug" Then Debug.Print "ご契約内容一覧_明細: Nご契約名義 (第一名義)end"
 
ここでRange("B" & lngRowPaste).Value がはいっていかなくなりました
 エラーメッセはでてこず、ずーと取得中ですになってしまいます。とても長文なので全部を載せる事ができないため大体つくりはこういった感じなのでここら辺の○○を見直してみるといいデスみたいなアドバイスでも結構です。
とても困っています。よろしくおねがいいたします
 
(ACCESSVBA初心者です。)

回答
投稿日時: 18/04/30 19:03:09
投稿者: よろずや

提示された部分は、差し替えた部分が全て含まれているのですか?
ACCESS VBA と言っていますが、提示された内容は ACCESS VBA から EXCEL VBA を実行しているもので
難易度は結構高いと思います。
ピリオド一つ間違えただけでおかしなことになります。

回答
投稿日時: 18/05/01 09:47:59
投稿者: sk

引用:
With prSHT
 'Nご契約名義 (第一名義)
lngRowPaste = lngRowPasteST + 1
 .Range("B" & lngRowPaste).Value = Nz(RSout![15_ご契約名義(第一名義)], "")

引用:
ここでRange("B" & lngRowPaste).Value はいっていかなくなりました

ここでの「はいっていかない」とは、具体的に
どのような状態であることを意味しているのでしょうか。
 
少なくとも、ここでの Value プロパティは代入する側ではなく
代入される側であるわけですから、「Value はいっていかなく」
という表現では、正確な意味が伝わりづらいのではないかと思います。

回答
投稿日時: 18/05/01 15:02:50
投稿者: Suzu

引用:
ずーと取得中ですになってしまいます。

 
これは、どこに 【取得中です】が表示されるのですか?
 
それは、コードで表示させているのですか?
 
 
エラーや、予期しない動作をする直前にブレイクポイントを設け、
直前で一時停止させてから、シングルステップで実行し
 
問題の発生コードの位置を特定し、
そのコードの位置で、変数を使用していれば、
・変数の値に問題が無いか
・変数は想定通りの値になっているか
を確認しましょう。

投稿日時: 18/05/02 11:44:34
投稿者: 2011wing

皆さまいろいろありがとうございます。
解決に至らなかったので全文きさいいたしました。
どこを修正すれば良いか全く見当がつかず宜しくお願い申し上げます

投稿日時: 18/05/03 10:24:04
投稿者: 2011wing

 End WithのコメントアウトをはずしてみごとRUNできるようになりました。
 書式の設定も完了しましたので、問題なく改修が終了となりました
長文のところ見事バグをみつけてくださり、スキルに関心するとともに
感謝の気持ちでいっぱいです。
また何かありましたら宜しくお願い致します。
ありがとうございました。