中小企業の働き方改革をサポート>>

いつもお世話になっております。
Accessでデータをテンプレートに吐き出した後、Activeなシートのデータを別シートにコピーしたいと思いますが、以下のコードのLOOPの下に記述し他のですが、エラーが出てしまいます。
Accessでは使えない記述なのでしょうか?


Private Sub ShorttermTxExpo_DblClick(Cancel As Integer)

On Error GoTo Err_FileDialog_Click
Dim strsql As String
Dim strTemplate As String
Dim strFileName As String
Dim ExpFileName As String
Dim FileNameExpo As String
Dim xlapp As Object
Dim myCn As New ADODB.Connection
Dim myRs As New ADODB.Recordset

'ファイル名作成
FileNameExpo = DFirst("FileNameExpo", "Q_FileName_Shortterm2")
ExpFileName = "VA01_KE_OCR_Shortterm" & "_" & Format(Date, "yyyymmdd") & "_" & FileNameExpo
strFileName = GetFileName(False, "MicrosoftExcel ブック (*.xlsx)|*.xlsx", "", ExpFileName & ".xlsx")

'EXCELアプリケーションを起動
Set xlapp = CreateObject("Excel.Application")

'セットする過程が見えないよう一旦不可視
xlapp.Visible = False

Set myCn = CurrentProject.Connection

strsql = "Q_Shortterm2Expo"

'レコードセットオープン
myRs.Open strsql, myCn, adOpenForwardOnly, adLockReadOnly

With xlapp
'テンプレートを開く
strTemplate = Application.CurrentProject.Path & "\" & "VA01_KE_OCR_Shortterm.xlsx"

'テンプレートファイルが存在しないときはエラー
If Dir(strTemplate) = "" Then
MsgBox "テンプレートファイルを確認してください。", vbOKOnly + vbCritical, "エラー"
.Visible = True
.Quit
Exit Sub
End If

'テンプレートファイルオープン
.Workbooks.Open strTemplate

'結果値出力処理(1行目にヘッダーを表示しているので、2行目1列目からセット
.Worksheets("Sheet1").Cells(2, 1).CopyFromRecordset myRs

Dim I As Long

I = 2

.Worksheets("Sheet1").Activate
Do While .Worksheets("Sheet1").Cells(I, 1) <> ""

'関数挿入
.Worksheets("Sheet1").Cells(I, 34).Formula = "=IF(ISERROR(MID(Z" & I & ",FIND(""6"",Z" & I & "),10)),"""",MID(Z" & I & ",FIND(""6"",Z" & I & "),10))"

I = I + 1

Loop


.Worksheets("Sheet1").Activate
.Worksheets("Sheet1").Columns("C:D").Select
.Worksheets("Sheet1").Selection.Copy
.Worksheets("Validationチェック用").Activate
.Worksheets("Validationチェック用").Columns("A").Select
.Worksheets("Validationチェック用").ActiveSheet.Paste




'完了したら保存
If Len(strFileName) = 0 Then
.activeworkbook.Close SaveChanges:=False
xlapp.Quit
MsgBox "処理を中止します。", vbOKOnly + vbInformation
Exit Sub
Else
.activeworkbook.SaveAs FileName:=strFileName

End If

MsgBox "TX Shuttle用ファイルの出力が完了しました。", vbOKOnly + vbInformation

End With

Set myRs = Nothing: Close
Set myCn = Nothing: Close

'Excelを終了します
xlapp.Quit
Exit Sub

Exit_FileDialog_Click:
Exit Sub

Err_FileDialog_Click:
MsgBox "予期せぬエラーが発生しました" & Chr(13) & _
"エラーナンバー:" & Err.Number & Chr(13) & _
"エラー内容:" & Err.Description, vbOKOnly
End

Resume Exit_FileDialog_Click

End Sub

「AccessでExcelの操作」の質問画像

A 回答 (1件)

Accessの経験はほぼ絶滅危惧種な私ですが、気になった点を。



With xlapp

に対して

.Workbooks.Open

はまだわかりますけど、

.Worksheets~

はあり得ないのではないかと。
シートはブックの下なのでせめて

Dim xlWB as object
と宣言して

Set xlWB = .Workbooks.Open(strTemplate)

でBookを変数にセットして

xlWB.Worksheets~

とすべきなのでは?

.activeworkbook.Close SaveChanges:=False

.activeworkbook.SaveAs FileName:=strFileName

ここも

xlWB.Close~

などとするとか?(もしかしたら括弧で括るかも知れないけど)
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

このカテゴリの人気Q&Aランキング

おすすめ情報