Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1387 / 9994 ←次へ | 前へ→

【11905】サブフォームのデータをExcel出力
質問  かぼす  - 11/1/11(火) 21:08 -

引用なし
パスワード
   はじめまして。かぼすです。

Accessでメインフォームで抽出条件を設定し、
その結果をサブフォームに表示しています。

そのサブフォームの結果をExcelに出力するVBAを書いたのですが、
時々出力結果がおかしくなってしまいます。

VBAはこんな感じです。

Public xls As Excel.Application
Public wb As WorkBook
Public wks As WorkSheets
Public cntGyo

'--------------------------------------------------------------
Sub 結果出力()

 Dim Rcs As DAO.Recordset
 Dim r

 'サブフォーム1のデータを出力
 Set wks = wb.WorkSheets("Sheet1")
 Set Rcs = Forms!F_MainForm![F_SubForm1].Form.RecordsetClone

 cntGyo = Rcs.RecordCount

 r = 2
 If cntGyo<>0 Then
  Rcs.MoveFirst
  Do Until Rcs.EOF
   .Cells(r,2) = Rcs(1)
   .Cells(r,3) = Rcs(2)
   Rcs.MoveNext
   r = r+1
  Loop
 EndIf

 '罫線
 Keisen  '別のSubをCall(Sheet2も同様に使う)

 End With

 Rcs.Close
 Set Rcs = Nothing
 Set wks = Nothing

  'サブフォーム2のデータを出力
 Set wks = wb.WorkSheets("Sheet2")
 Set Rcs = Forms!F_MainForm![F_SubForm2].Form.RecordsetClone

 cntGyo = Rcs.RecordCount

 r = 2
 If cntGyo<>0 Then
  Rcs.MoveFirst
  Do Until Rcs.EOF
   .Cells(r,2) = Rcs(1)
   .Cells(r,3) = Rcs(2)
   .Cells(r,4) = Rcs(3)
   Rcs.MoveNext
   r = r+1
  Loop
 EndIf

 '罫線
 Keisen  '別のSubをCall(Sheet1も同様に使う)

 End With

 Rcs.Close
 Set Rcs = Nothing
 Set wks = Nothing
End Sub

'--------------------------------------------------------------
Sub Keisen()

 With Wks
  With .Range(.Cells(1,1),.Cells(cntGyo+1,3)).Borders
   .LineStyle = xlsContinuous
   .Weight = xlThin
  End With

  .Cells(cntGyo+4, 1) = "コメント"
  .Cells(cntGyo+5, 1) = "〇:変更する"
  .Cells(cntGyo+6, 1) = "×:変更なし"
 End With

End Sub

具体的な現象は、Sub Keisenで罫線が描かれる行、コメントが書かれる行が
Sub 結果出力で出力されたデータ行と異なってしまいます。
(データ行より罫線行が少ない、コメントがデータ行にかぶってしまう)

この現象がうまくいく時、いかない時があり
何が原因なのかわからず困っています。

どなたか教えてください。

環境:WindowsXP、Accss2002
足りない情報があれば遠慮なく言って下さい。

よろしくお願いします。

635 hits

【11905】サブフォームのデータをExcel出力 かぼす 11/1/11(火) 21:08 質問[未読]
【11906】Re:サブフォームのデータをExcel出力 11/1/14(金) 12:50 回答[未読]

1387 / 9994 ←次へ | 前へ→
ページ:  ┃  記事番号:
1078193
(SS)C-BOARD v3.8 is Free