Access VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

8242 / 9994

←次へ　｜　前へ→


	【4930】Re:エクスポート時にシート名をコントロー...

小僧 - 05/4/20(水) 11:56 -


	引用なし

	パスワード

▼にしもりさん：
こんにちは。

>もうすこし自分の力で研究してみたいと思います。

【4919】Re:既存のExcelファイルにエクスポートするには
のコードを少し改変してあります。
少しでも研究のお力になれれば幸いです。

Sub xlsOut2()
Dim FSO As Object
Dim RS As DAO.Recordset
Dim xlsApp As New Excel.Application
Dim xlsWkb As New Excel.Workbook
Dim xlsSht As New Excel.Worksheet
Dim MyTBL As String
Dim MyFile As Variant
Dim ShtName As String
Dim MySheet As Variant
Dim Cnt As Long
Dim FLG As Boolean

'出力するテーブル、出力先ファイルの指定
　　MyFile = "C:\回数_埼玉.xls"
　　MyTBL = "回数_当月"
　　ShtName = "回数_4月"
　
'MyFileの存在チェック
　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　　　If Not (FSO.FileExists(MyFile)) Then
　　　　
'MyFileがなかった時はそのままエクスポート
　　　　　　DoCmd.TransferSpreadsheet acExport, _
　　　　　　acSpreadsheetTypeExcel9, MyTBL, MyFile, True
　
'シートの名前を変更
　　　　　　Set xlsWkb = xlsApp.Workbooks.Open(MyFile)
　　　　　　xlsWkb.Sheets(MyTBL).Name = ShtName
　　　　　　xlsWkb.Save
　　　　　　xlsWkb.Close: Set xlsWkb = Nothing
　　　　　　xlsApp.Quit: Set xlsApp = Nothing
　　　　Else
　　　　
'MyFileがあった時はレコードセットにMyTBLの値を代入
　　　　　　Set RS = CurrentDb.OpenRecordset(MyTBL, dbOpenDynaset)
　　　　　　Set xlsWkb = xlsApp.Workbooks.Open(MyFile)

'同名のシートの検索
　　　　　　FLG = False
　　　　　　For Each MySheet In xlsWkb.Sheets
　　　　　　　　If MySheet.Name = ShtName Then
　　　　　　　　　　FLG = True
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next

'同名のシートがあった場合は全クリア、
'無かった場合はブックの最後にシートを追加
　　　　　　If FLG Then
　　　　　　　　xlsWkb.Sheets(ShtName).Cells.ClearContents
　　　　　　Else
　　　　　　　　Cnt = xlsWkb.Sheets.Count
　　　　　　　　xlsWkb.Sheets.Add after:=xlsApp.Worksheets(Cnt)
　　　　　　　　xlsWkb.ActiveSheet.Name = ShtName
　　　　　　End If
　　　　　　
'シートを開く
　　　　　　Set xlsSht = xlsWkb.Sheets(ShtName)
　　　　　　
'シートの１行目はフィールドの名前を書き込む
　　　　　　For Cnt = 1 To RS.Fields.Count
　　　　　　　　xlsSht.Cells(1, Cnt).Value = RS.Fields(Cnt - 1).Name
　　　　　　Next

'シートの２行目以降はレコードセットに代入された値をコピー
　　　　　　xlsSht.Range("A2").CopyFromRecordset RS
　　　　　　
'シートの保存、オブジェクトの開放
　　　　　　xlsWkb.Save
　　　　　　xlsWkb.Close: Set xlsSht = Nothing: Set xlsWkb = Nothing
　　　　　　xlsApp.Quit: Set xlsApp = Nothing
　　　　　　RS.Close
　　　　　　Set RS = Nothing
　　　　End If
End Sub

2,838 hits

▼

【4924】エクスポート時にシート名をコントロールするには にしもり 05/4/19(火) 10:08