Access VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1839 / 2272 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【4842】既存のExcelファイルにエクスポートするには にしもり 05/4/7(木) 16:34 質問[未読]
【4844】Re:既存のExcelファイルにエクスポートす... 小僧 05/4/8(金) 11:18 回答[未読]
【4849】Re:既存のExcelファイルにエクスポートす... にしもり 05/4/8(金) 16:13 お礼[未読]
【4867】Re:既存のExcelファイルにエクスポートす... 小僧 05/4/11(月) 10:27 発言[未読]
【4899】Re:既存のExcelファイルにエクスポートす... clike 05/4/15(金) 11:26 質問[未読]
【4900】Re:既存のExcelファイルにエクスポートす... 小僧 05/4/15(金) 12:44 回答[未読]
【4901】Re:既存のExcelファイルにエクスポートす... clike 05/4/15(金) 13:07 質問[未読]
【4902】Re:既存のExcelファイルにエクスポートす... 小僧 05/4/15(金) 14:09 回答[未読]
【4906】Re:既存のExcelファイルにエクスポートす... clike 05/4/15(金) 17:39 質問[未読]
【4919】Re:既存のExcelファイルにエクスポートす... 小僧 05/4/18(月) 9:56 回答[未読]
【5018】Re:既存のExcelファイルにエクスポートす... にしもり 05/5/13(金) 12:47 質問[未読]
【5019】Re:既存のExcelファイルにエクスポートす... 小僧 05/5/13(金) 13:47 回答[未読]
【5020】Re:既存のExcelファイルにエクスポートす... にしもり 05/5/13(金) 14:06 お礼[未読]
【4842】既存のExcelファイルにエクスポートするに...
質問  にしもり  - 05/4/7(木) 16:34 -
引用なし
パスワード
   こんにちは。
下記のようにAccessテーブルaaをExcelのファイル「回数表」にエクスポートしています。
これを２回３回・・と実行し、その都度シートが追加されるようにしたいのです。
シート名がaa ,aa(2),aa(3)・・というふうになれば十分です。
どうすればよろしいですか？

DoCmd.TransferSpreadsheet acExport, cSpreadsheetTypeExcel97, "aa", "C:\新しいフォルダ\回数表.xls"
【4844】Re:既存のExcelファイルにエクスポートす...
回答  小僧  - 05/4/8(金) 11:18 -
引用なし
パスワード
   ▼にしもり さん：
こんにちわ。
あまり綺麗なコードでないので申し訳ないのですが…

※エクセルとADOの参照設定をしてください。

Sub TEST()
Dim FSO As Object
Dim xlsApp As New Excel.Application
Dim xlsWkb As New Excel.Workbook
Dim MyFile As Variant
Dim Cnt As Long

'出力ファイルの指定
　　MyFile = "C:\新しいフォルダ\回数表.xls"

'存在チェック
　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　　　If Not (FSO.FileExists(MyFile)) Then
　　　　　　DoCmd.TransferSpreadsheet acExport, _
　　　　　　acSpreadsheetTypeExcel9, "aa", MyFile, True
　　　　Else

'出力先ファイルにシートを追加
　　　　　　Set xlsWkb = xlsApp.Workbooks.Open(MyFile)
　　　　　　Cnt = xlsWkb.Sheets.Count
　　　　　　xlsWkb.Sheets.Add after:=xlsApp.Worksheets(Cnt)
　　　　　　xlsWkb.ActiveSheet.Name = "aa" & Cnt
　　　　　　xlsWkb.Save
　　　　　　xlsWkb.Close: Set xlsWkb = Nothing
　　　　　　xlsApp.Quit: Set xlsApp = Nothing
　　　　
　　　　DoCmd.TransferSpreadsheet acExport, _
　　　　acSpreadsheetTypeExcel9, "aa", MyFile, True, "aa" & Cnt & "!"
　　　　End If
End Sub

「TransferSpreadsheet」のヘルプには「acExport」の際のRange指定は
記載されていないので正しい使い方ではないと思いますが、
当方の環境では作動しております。（WindowsXP/Access2002/Excel2002）
【4849】Re:既存のExcelファイルにエクスポートす...
お礼  にしもり  - 05/4/8(金) 16:13 -
引用なし
パスワード
   ▼小僧 さん：
はじめてADOというものをつかいました。
参照設定に少々手間取りました。
参考書をみたら「OLE DBプロバイダを介して云々・・」と、理解不能な文が書いてあり、私には無理かなと思ったのですが、がんばってさがしたらﾂｰﾙの中にありました。
小僧さんのプログラムは、一発OKで、しかも完璧でした。
本当にありがとうございました。
今後ともご指導のほどよろしくお願いいたします。
【4867】Re:既存のExcelファイルにエクスポートす...
発言  小僧  - 05/4/11(月) 10:27 -
引用なし
パスワード
   土曜日にちょっと覗いた時に、シート名を日付で…という
投稿があったように思われたのですが、削除されてしましましたね…。

コードを考えたのでアップしておきます。

Sub xlsOut()
Dim FSO As Object
Dim xlsApp As New Excel.Application
Dim xlsWkb As New Excel.Workbook
Dim MyTBL As String
Dim MyFile As Variant
Dim MyDate As String
Dim MySheet As Variant
Dim Cnt As Long
　　
'出力するテーブル、出力先ファイルの指定
　　MyDate = Format(Now(), "m月dd日")
　　MyTBL = "tempTBL"
　　MyFile = "c:\temp.xls"

'存在チェック
　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　　　If Not (FSO.FileExists(MyFile)) Then
　　　　　　DoCmd.TransferSpreadsheet acExport, _
　　　　　　acSpreadsheetTypeExcel9, MyTBL, MyFile, True
　　　　　　
'エクセルシートの名前を変更
　　　　　　Set xlsWkb = xlsApp.Workbooks.Open(MyFile)
　　　　　　xlsWkb.Sheets(MyTBL).Name = MyDate
　　　　　　xlsWkb.Save
　　　　　　xlsWkb.Close: Set xlsWkb = Nothing
　　　　　　xlsApp.Quit: Set xlsApp = Nothing
　　　　Else

'同日のシートが見つかった場合は削除
　　　　　　Set xlsWkb = xlsApp.Workbooks.Open(MyFile)
　　　　　　For Each MySheet In xlsWkb.Sheets
　　　　　　　　If MySheet.Name = MyDate Then
　　　　　　　　　　xlsApp.DisplayAlerts = False
　　　　　　　　　　xlsWkb.Sheets(MyDate).Delete
　　　　　　　　　　xlsApp.DisplayAlerts = True
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next

'出力先ファイルにシートを追加
　　　　　　Cnt = xlsWkb.Sheets.Count
　　　　　　xlsWkb.Sheets.Add after:=xlsApp.Worksheets(Cnt)
　　　　　　xlsWkb.ActiveSheet.Name = MyDate
　　　　　　xlsWkb.Save
　　　　　　xlsWkb.Close: Set xlsWkb = Nothing
　　　　　　xlsApp.Quit: Set xlsApp = Nothing
　　　　DoCmd.TransferSpreadsheet acExport, _
　　　　acSpreadsheetTypeExcel9, MyTBL, MyFile, True, MyDate & "!"
　　　　End If
End Sub

１日に複数回出力した場合は、最新のシートのみが存在します。
【4899】Re:既存のExcelファイルにエクスポートす...
質問  clike E-MAIL  - 05/4/15(金) 11:26 -
引用なし
パスワード
   ご回答をいただき、ありがとうございます。
いくつかの質問がありますので、よろしくお願いします。
操作のどこかに間違いがあると思いますが、教えていただけませんか？

以下の環境で試しました。
c:\temp.xls→作成した
access2003にてtempTBL→作成した

「sub／ユーザーフォームの実行」を押したら、

コンバイルエラー：
ユーザ定義型は定義されていません。
というメッセージがでています。
Dim xlsApp As New Excel.Application　色反転になっている
【4900】Re:既存のExcelファイルにエクスポートす...
回答  小僧  - 05/4/15(金) 12:44 -
引用なし
パスワード
   ▼clike さん：
こんにちは。

すみません。
※要Excelの参照設定　を書くのを忘れていました。

Excelの参照設定を確認してみてください。

以下のようにすると参照設定なしでもうまくいきます。

>Sub xlsOut()
>Dim FSO As Object
>'Dim xlsApp As New Excel.Application
→Dim xlsApp As Object

>'Dim xlsWkb As New Excel.Workbook
→Dim xlsWkb As Object

>Dim MyTBL As String
>Dim MyFile As Variant
>Dim MyDate As String
>Dim MySheet As Variant
>Dim Cnt As Long

→追記
　　 Set xlsApp = CreateObject("Excel.Application")

>'出力するテーブル、出力先ファイルの指定
>　　MyDate = Format(Now(), "m月dd日")
>　　MyTBL = "tempTBL"
>　　MyFile = "c:\temp.xls"

以下略
【4901】Re:既存のExcelファイルにエクスポートす...
質問  clike E-MAIL  - 05/4/15(金) 13:07 -
引用なし
パスワード
   大変ありがとうございます。
無事に通りました。
追加されたシートにフィールドとレコードの間にnull行が
入っています。なくす方法はあるのでしょうか？
またテーブルではなく、クエリの場合は、利用かのでしょうか？
【4902】Re:既存のExcelファイルにエクスポートす...
回答  小僧  - 05/4/15(金) 14:09 -
引用なし
パスワード
   ▼clike さん：
お待たせ致しました。ご指摘の通り、一行なんか空白がありますね…。

まぁ DoCmd.TransferSpreadsheet　を正しく使っていない結果でしょうか。
以下のように修正しました。コードがややこしくなってしまい申し訳ないです。

※要Excel,DAO参照設定

Sub xlsOut()
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 MyDate As String
Dim MySheet As Variant
Dim Cnt As Long
　
'出力するテーブル、出力先ファイルの指定
　　MyDate = Format(Now(), "m月dd日")
　　MyTBL = "tempTBL"
　　MyFile = "c:\temp.xls"
　　
'存在チェック
　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　　　If Not (FSO.FileExists(MyFile)) Then
　　　　　　DoCmd.TransferSpreadsheet acExport, _
　　　　　　acSpreadsheetTypeExcel9, MyTBL, MyFile, True
　　　
'エクセルシートの名前を変更
　　　　　　Set xlsWkb = xlsApp.Workbooks.Open(MyFile)
　　　　　　xlsWkb.Sheets(MyTBL).Name = MyDate
　　　　　　xlsWkb.Save
　　　　　　xlsWkb.Close: Set xlsWkb = Nothing
　　　　　　xlsApp.Quit: Set xlsApp = Nothing
　　　　Else

'同日のシートが見つかった場合は削除
　　　　　　Set RS = CurrentDb.OpenRecordset(MyTBL, dbOpenDynaset)　　　　
　　　　　　Set xlsWkb = xlsApp.Workbooks.Open(MyFile)
　　　　　　For Each MySheet In xlsWkb.Sheets
　　　　　　　　If MySheet.Name = MyDate Then
　　　　　　　　　　xlsApp.DisplayAlerts = False
　　　　　　　　　　xlsWkb.Sheets(MyDate).Delete
　　　　　　　　　　xlsApp.DisplayAlerts = True
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next

'出力先ファイルにシートを追加
　　　　　　Cnt = xlsWkb.Sheets.Count
　　　　　　xlsWkb.Sheets.Add after:=xlsApp.Worksheets(Cnt)
　　　　　　Set xlsSht = xlsWkb.ActiveSheet
　　　　　　xlsSht.Name = MyDate
　　　　　　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

>またテーブルではなく、クエリの場合は、利用かのでしょうか？

よくこういったご質問をお見かけしますが、
「まずやってみる！」のはいかがでしょうか？
（テストができない環境でしたら申し訳ありません。）

やってみて不具合がでる、うまくいくけど何か不安、etc…　でしたら
再度投稿して頂ければ出来る限り（私でなくてもどなたかがきっと）
お答えしますので、提示されたコードをコピーするだけでなく、
がんばってオリジナルにも挑戦して頂きたいなと思います。

ちなみにこのコードですと変数：MyTBL にクエリの名前を入れて頂ければ
Excelに出力可能です。
【4906】Re:既存のExcelファイルにエクスポートす...
質問  clike E-MAIL  - 05/4/15(金) 17:39 -
引用なし
パスワード
   マクロのプロシージャから実行できるように
関数として、Functionに変えました。
マクロのプロシージャから実行すると、
「実行エラー'1004':
ブックのシートをすべて削除または非表示にすることはできません」
というエラー表示がでています。
xlsWkb.Sheets(MyDate).Delete==>色反転
【4919】Re:既存のExcelファイルにエクスポートす...
回答  小僧  - 05/4/18(月) 9:56 -
引用なし
パスワード
   ▼clike さん：
おはようございます。

>「実行エラー'1004':
>ブックのシートをすべて削除または非表示にすることはできません」
>というエラー表示がでています。

シートが１枚しかない時は削除できない、という事を
考慮しておりませんでした。
当日のシートがあった時は削除でなく、クリア処理で対応してみました。

Sub xlsOut()
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 MyDate As String
Dim MySheet As Variant
Dim Cnt As Long
Dim FLG As Boolean

'出力するテーブル、出力先ファイルの指定
　　MyDate = Format(Now(), "m月dd日")
　　MyTBL = "tempTBL"
　　MyFile = "c:\temp.xls"
　
'存在チェック
　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　　　If Not (FSO.FileExists(MyFile)) Then
　　　　　　DoCmd.TransferSpreadsheet acExport, _
　　　　　　acSpreadsheetTypeExcel9, MyTBL, MyFile, True
　
'エクセルシートの名前を変更
　　　　　　Set xlsWkb = xlsApp.Workbooks.Open(MyFile)
　　　　　　xlsWkb.Sheets(MyTBL).Name = MyDate
　　　　　　xlsWkb.Save
　　　　　　xlsWkb.Close: Set xlsWkb = Nothing
　　　　　　xlsApp.Quit: Set xlsApp = Nothing
　　　　Else
　　　　
　　　　　　Set RS = CurrentDb.OpenRecordset(MyTBL, dbOpenDynaset)
　　　　　　Set xlsWkb = xlsApp.Workbooks.Open(MyFile)

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

'出力先ファイルのシートを選択
　　　　　　If FLG Then
　　　　　　　　xlsWkb.Sheets(MyDate).Cells.ClearContents
　　　　　　Else
　　　　　　　　Cnt = xlsWkb.Sheets.Count
　　　　　　　　xlsWkb.Sheets.Add after:=xlsApp.Worksheets(Cnt)
　　　　　　　　xlsWkb.ActiveSheet.Name = MyDate
　　　　　　End If
　　　　　　
'シートへの書き込み
　　　　　　Set xlsSht = xlsWkb.Sheets(MyDate)
　　　　　　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
【5018】Re:既存のExcelファイルにエクスポートす...
質問  にしもり  - 05/5/13(金) 12:47 -
引用なし
パスワード
   ▼小僧 さん：
何回も似た質問をしてもうしわけございませんでした。
また、多くの方にレスいただき、どうもありがとうございます。
小僧さんのを使わせていただいております。
で、下のプログラムですが、タイトルは１行目に出るのですが、
値が３行目から出てしまいます。
値を２行目から出すためにどう改良すればよいかわかりません。
どうかご教示ください。

>Sub TEST()
>Dim FSO As Object
>Dim xlsApp As New Excel.Application
>Dim xlsWkb As New Excel.Workbook
>Dim MyFile As Variant
>Dim Cnt As Long
>
>'出力ファイルの指定
>　　MyFile = "C:\新しいフォルダ\回数表.xls"
>
>'存在チェック
>　　Set FSO = CreateObject("Scripting.FileSystemObject")
>　　　　If Not (FSO.FileExists(MyFile)) Then
>　　　　　　DoCmd.TransferSpreadsheet acExport, _
>　　　　　　acSpreadsheetTypeExcel9, "aa", MyFile, True
>　　　　Else
>
>'出力先ファイルにシートを追加
>　　　　　　Set xlsWkb = xlsApp.Workbooks.Open(MyFile)
>　　　　　　Cnt = xlsWkb.Sheets.Count
>　　　　　　xlsWkb.Sheets.Add after:=xlsApp.Worksheets(Cnt)
>　　　　　　xlsWkb.ActiveSheet.Name = "aa" & Cnt
>　　　　　　xlsWkb.Save
>　　　　　　xlsWkb.Close: Set xlsWkb = Nothing
>　　　　　　xlsApp.Quit: Set xlsApp = Nothing
>　　　　
>　　　　DoCmd.TransferSpreadsheet acExport, _
>　　　　acSpreadsheetTypeExcel9, "aa", MyFile, True, "aa" & Cnt & "!"
>　　　　End If
>End Sub
【5019】Re:既存のExcelファイルにエクスポートす...
回答  小僧  - 05/5/13(金) 13:47 -
引用なし
パスワード
   ▼にしもり さん：
こんにちは。Accessの方はお久しぶりですね。

[#4844]にて
>「TransferSpreadsheet」のヘルプには「acExport」の際のRange指定は
>記載されていないので正しい使い方ではないと思いますが、
>当方の環境では作動しております。（WindowsXP/Access2002/Excel2002）

と書きましたが、やはり正しい使い方でないのか弊害がでてしまいました。
Excel の CopyFromRecordset というメソッドを使用してコードを書き直しました。

Sub TEST2()
Dim FSO As Object
Dim xlsApp As New Excel.Application
Dim xlsWkb As Excel.Workbook
Dim xlsSht As Excel.Worksheet
Dim MyFile As Variant
Dim Cnt As Long
'
'TBLのデータをレコードセットに記録
'-----------------------------------------------------------
　　'DAOの場合
　　Dim RS As DAO.Recordset
　　Set RS = CurrentDb.OpenRecordset("aa")
　　
　　'ADOの場合
　　'Dim RS As New ADODB.Recordset
　　'RS.Open "SELECT * FROM aa", CurrentProject.Connection
'-----------------------------------------------------------

'出力ファイルの指定
　　MyFile = "C:\新しいフォルダ\回数表.xls"
　　MyFile = "C:\Documents and Settings\x0007546.MOS\デスクトップ\サンプル\aaa.xls"

'存在チェック
　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　　　If Not (FSO.FileExists(MyFile)) Then
　　　　　　DoCmd.TransferSpreadsheet acExport, _
　　　　　　acSpreadsheetTypeExcel9, "aa", MyFile, True
　　　　Else

'出力先ファイルにシートを追加
　　　　　　Set xlsWkb = xlsApp.Workbooks.Open(MyFile)
　　　　　　Cnt = xlsWkb.Sheets.Count
　　　　　　xlsWkb.Sheets.Add after:=xlsApp.Worksheets(Cnt)
　　　　　　Set xlsSht = xlsWkb.ActiveSheet
　　　　　　xlsSht.name = "aa" & Cnt
　　　　　　　　For Cnt = 1 To RS.Fields.Count
　　　　　　　　　　xlsSht.Cells(1, Cnt).Value = RS.Fields(Cnt - 1).name
　　　　　　　　Next
　　　　　　xlsSht.Range("A2").CopyFromRecordset RS
　　　　　　xlsWkb.Close True: Set xlsWkb = Nothing
　　　　　　xlsApp.Quit: Set xlsApp = Nothing
　　　　End If
　　RS.Close
　　Set RS = Nothing
End Sub

参照設定を開いて、
>> Microsoft DAO x.x Object Library
にチェックがついていればDAOで、

>> Microsoft ActiveX Data Objects x.x Library
にチェックがついていればADOで、

両方ともチェックがあればお好きな方で試してみてください。
【5020】Re:既存のExcelファイルにエクスポートす...
お礼  にしもり  - 05/5/13(金) 14:06 -
引用なし
パスワード
   ▼小僧 さん：
いまAccessとExcelの両方を使っております。
ご教示いただいたとおりにやったところできました。
結果のみを使わせていただき申し訳なく思っております。
自分で精進したいと思っています。
ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1839 / 2272 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
1084189
(SS)C-BOARD v3.8 is Free