• 締切済み

accessのデータをexcelに

Office97使用のシステム管理初級者です。 accessのクエリーを利用して以下のようなシステムを作ろうと思っているのですが、行き詰っています。 (1) 特定のデータ(複数)を抽出 (2) 既に用意しているexcelの任意の位置にデータを移管 (3) excelのブックを別名にてフロッピーに保存 (1)は何とかできたのですが、(1)によって抽出できたデータを任意のexcelに移管する時、最初の1データしか移管できなくて困っています。(次のようなものです・・・。) Private Sub エクセル起動_Click() On Error GoTo Err_エクセル起動_Click Dim oApp As Object Set oApp = CreateObject("Excel.Application") oApp.Visible = True 'Only XL 97 supports UserControl Property On Error Resume Next oApp.UserControl = True oApp.Workbooks.Open FileName:="D:\****\123.xls" oApp.range("b4").Value = Me![1] oApp.range("c8").Value = Me![2] oApp.range("d8").Value = Me![3] oApp.range("e8").Value = Me![4] oApp.range("f8").Value = Me![5] oApp.range("g8").Value = Me![6] oApp.range("h8").Value = Me![7] oApp.range("i8").Value = Me![8] oApp.range("j8").Value = Me![9] Exit_エクセル起動_Click: Exit Sub Err_エクセル起動_Click: MsgBox Err.Description Resume Exit_エクセル起動_Click End Sub それぞれの行にズラーッとデータがきて、さらにそのexcelを別名にてフロッピーに保存したいのですが、どのようにすればいいのでしょうか? よろしくお願いします。

みんなの回答

  • ryuu001
  • ベストアンサー率61% (46/75)
回答No.4

> セルb2に入ってるデータ「****」とかを、そのままブック名にして保存 a1 に pathとファイル名が入っていたとして、 (例えば D:\****\123456.xls とか) oApp.ActiveWorkbook.SaveAs ( oApp.cells(1,1) ) で、良いのじゃないかと思います。 試していませんが、多分OKだと思います。

tanaben
質問者

お礼

ryuu001さん、ありがとうございます! 早速試してみます。

  • ryuu001
  • ベストアンサー率61% (46/75)
回答No.3

名前を付けて保存は次の通りです。 oApp.ActiveWorkbook.SaveAs Filename:="D:\****\123456.xls"

tanaben
質問者

お礼

ryuu001さん、ありがとうございます。 例えば、セルb2に入ってるデータ「****」とかを、そのままブック名にして保存できる方法はありますか? よろしければ、教えて下さい。

  • mayurin
  • ベストアンサー率25% (49/193)
回答No.2

こんにちは。Accessからであれば、TransferSpreadsheet関数を使う というのはどうでしょうか? 考慮済みならすいません。 参考URLでもいろいろ事例を検索できると思います。詳しくはヘルプなど 見てみて下さい。(きちんと書くのはちょっと自信ないので・・・)

参考URL:
http://www7.big.or.jp/~pinball/
tanaben
質問者

お礼

mayurinさん、ありがとうございます。 TransferSpreadsheet関数ですね。 むずかしそうだけど、頑張ってみます。

回答No.1

こんにちは、ats8181oyajiです ちょっと時間が無いので、ヒントにもならないですが 回答が無いので、出てまいりました。 たぶん、フォームのデータを以下の様に "oApp.range("b4").Value = Me![1]" エクセルに格納されてますがもこれだと 1行だけになると思います。 私なら 1.抽出データを画面表示前に、テーブル作成クエリにて、新規テーブルを作成 2.そのテーブルをPrivate Sub エクセル起動_Click() 内にて レコードセットを使いオープンしEOFまでループしながら読み込み。 3.そのループの中に、読み込んだデータを(エクセルの行を変更しながら) エクセルにセットする とします。 詳しいコーディングは、他の方におまかせします。 では

tanaben
質問者

お礼

ats8181oyajiさん、ありがとうございます。 参考にさせて頂きます。 ありがとうございました。

関連するQ&A

  • ACCESSとEXCELの連携について

    ACCESSとEXCELの連携について教えてください。 メインフォームA(単票)の中にサブフォームB(単票)があり、更にサブフォームB(単票)の中にサブフォーム(メインからみると孫フォーム)C(帳票)があるという構成のフォームがあります。各フォームにはそれぞれテキストボックスtext_X,text_Y,text_Zがあり、メインフォームにコマンドボタンQがあります。いま、このコマンドボタンQをクリックすることによってtext_X,text_Y,text_Zの内容をEXCELの特定ファイルの特定セル(例えばL1、M1、N1~10)に反映させたいと思っているのですが、メインフォーム(A)にあるtext_Xとサブフォーム(B)にあるtext_YはEXCELのセル(L1、M1)に取り込むことができるのですが、孫フォーム(C)にあるtext_Zをセル(N1~10)に反映させることが出来ません。text_Zはフォームが帳票フォームであることからLOOPを使っています。コマンドボタンQのクリック時のイベントでコードの書き方が違っているらしいのです。VBAは全く素人の手探り状態です。どなたか、素人でもわかるように教えていただけたら幸いです。よろしくお願い致します。 具体的には次のようなものです。(一部抜粋) Private Sub コマンド145_Click() Dim oApp As Object Dim rs As DAO.Recordset Dim i As Long Set rs = Me!営業入力SF.Form.RecordsetClone Set rs = 担当(1)F.Form.RecordsetClone Set oApp = CreateObject("Excel.Application") oApp.Visible = True 'Only XL 97 supports UserControl Property On Error Resume Next oApp.UserControl = True '指定のエクセルファイルを開く oApp.Workbooks.Open Filename:="I:\再出発!\受注票.xlt" 'エクセルファイルへデータセットする oApp.Range("名称").Value = Me![名称] oApp.Range("住所").Value = Me![住所] oApp.Range("パンフ送付").Value = Forms![営業F]![営業入力SF]![パンフ送付日] oApp.Range("DVD送付").Value = Forms![営業F]![営業入力SF]![DVD送付日] oApp.Range("正式見積書").Value = Forms![営業F]![営業入力SF]![正式見積書送付日] oApp.Range("契約書送付").Value = Forms![営業F]![営業入力SF]![契約完了日] 'サブフォームの内容をエクスポートする i = 11 Do Until rs.EOF oApp.Range("J" & Format(i)).Value = rs!テキスト1 oApp.Range("L" & Format(i)).Value = rs!テキスト4 i = i + 1 rs.MoveNext Loop Set rs = Nothing Exit_コマンド145_Click: Exit Sub Err_コマンド145_Click: MsgBox Err.Description Resume Exit_コマンド145_Click End Sub (WINDOWS XP    ACCESS 2002  EXCEL 2002 を使用)

  • アクセスからエクセルを開いてデータを取得するには?

    こんにちは。 MS AccessからExcelを開いて、Excel上のデータを取得したいのですが、下記のようにしたらエラーとなりました。CellsがNGみたいなのですが、AccessではCellsは使用出来ないのでしょうか? 宜しくお願いします。 Dim oApp As Object Set oApp = CreateObject("Excel.Application") oApp.Visible = True On Error Resume Next oApp.UserControl = True oApp.Workbooks.Open Filename:="C:\TEST\Book1.xls" GYO = 1 Do KI = Cells(GYO, 1).Value MsgBox KI GYO = GYO + 1 Loop Until Cells(GYO, 1) = ""

  • ACCESSのVBAでテンプレとなるxlsファイルを開き、編集を完了し

    ACCESSのVBAでテンプレとなるxlsファイルを開き、編集を完了してSaveAsメソッドで違う名前で保存したいのですが、以下のコーディングではパス名が存在しないor別プログラムで開かれているなどとエラーメッセージが表示されます。どこがいけないのでしょうか?   Dim oApp As Object Dim xlBook As Object Dim strWORK As String Dim i As Integer Dim strMDBPATH As String Dim strXLSFILE As String Dim strSaveFile As String 'Accessの起動位置を取得 strWORK = CurrentDb.Name '後ろから1文字単位で¥を探す For i = Len(strWORK) To 1 Step -1 If Mid(strWORK, i, 1) = "\" Then Exit For '¥だったら抜ける Next i 'D:\xxxx\yyyy\zzz.mdb --> D:\xxxx\yyyy\ にする strMDBPATH = Mid(strWORK, 1, i) 'Excelの元ファイルの名前を作成 D:\xxxx\yyyy\ + テンプレート.xls strXLSFILE = strMDBPATH & "回答票テンプレ.xls" Set oApp = CreateObject("Excel.Application") Set xlBook = oApp.Workbooks.Open(strXLSFILE) oApp.Visible = True 'Only XL 97 supports UserControl Property ' On Error Resume Next ' oApp.UserControl = True '回答票テンプレを開く ' oApp.Workbooks.Open FileName:=strXLSFILE oApp.Range("C10") = Me!起票日.Value oApp.Range("H10") = Me!所属部門.Value oApp.Range("P10") = Me!起票社員番号.Value oApp.Range("T10") = Me!起票社員名.Value oApp.Range("C17") = Me!対象システム.Value oApp.Range("K17") = Me!処理区分.Value oApp.Range("P17") = Me!対象画面.Value oApp.Range("C21") = Me!改修内容.Value oApp.Range("C38") = Me!回答日.Value oApp.Range("I38") = Me!回答社員名.Value oApp.Range("C43") = Me!回答内容.Value strSaveFile = Me!所属部門 & "_" & Me!起票日 & ".xls" xlBook.SaveAs FileName:=strMDBPATH & strSaveFile

  • クエリデータの取り出し

    下記のようなコードを使い、データだけをEXCELファイルに出していますが、間違えてEXCELファイルを削除した場合データが出ません、 アクセスでEXCELファイルを作成し、クエリデータを出す事は可能でしょうか?初心者の為コードの使い方等々解りません、宜しくお願いします。 Private Sub コマンド62_Click() On Error GoTo Err_コマンド62_Click Dim stDocName As String stDocName = "集計" DoCmd.TransferSpreadsheet acExport, , "集計", "C:\Documents and Settings\user\デスクトップ\ABC\data2" Exit_コマンド62_Click: Exit Sub Err_コマンド62_Click: MsgBox Err.Description Resume Exit_コマンド62_Click End Sub

  • アクセスのVBAについて、フォームの On Error Goto についておしえてください。

    Private Sub cmd次_Click() On Error GoTo Err DoCmd.GoToRecord , , acNext Exit_Click: Exit Sub Err: MsgBox "この先にレコードがなくなると、ここをつうかするのだろうか。" Resume Exit_Click End Sub 一連の流れについて,ご解説ください。よろしくお願いいたします。

  • accessで、フォームの検索をしたいのです。

    今ACCESSで、データ管理をしているのですが、どうしてもうまくいかなくて、困っています。 毎日の出来事を記述するテーブル用のフォームを作って、記述していて、そのデータがたまってきています。 他のフォームに、検索用のテキストボックスとコマンドボックスを作って検索したいのです。 コントロールウィザードを使うと、完全一致のデータしかでてこないのですが、部分一致のレコードを表示させるにはどうすればいいのですか? 教えていただけるとうれしいです。 コントロールウィザードを使うと以下のようになります。多分少しどこかを変えるといいのではないかと思うのです。どうか、よろしくお願いします。 Private Sub コマンド144_Click() On Error GoTo Err_コマンド144_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = ChrW(21839) & ChrW(12356) & ChrW(21512) & ChrW(12431) & ChrW(12379) & ChrW(12513) & ChrW(12514) stLinkCriteria = "[内容]=" & "'" & Me![テキスト105] & "'" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_コマンド144_Click: Exit Sub Err_コマンド144_Click: MsgBox Err.Description Resume Exit_コマンド144_Click End Sub もしかして。。と思い、以下の部分、 stLinkCriteria = "[内容]=" & "'" & Me![テキスト105] & "'" を次のように変えてみたけれど、やっぱりうまくいきませんでした。 stLinkCriteria = "[内容]=" & "'" & "*" & Me![テキスト105] & "*" & "'" よろしくお願いします。

  • エクセル VBAについて。

    Private Sub ComboBox2_Change() On Error Resume Next With Me.ComboBox2 If .ListCount < 0 Then Exit Sub If .Value = "" Then Exit Sub Me.Range("K45").Value = _ Worksheets("マスタ").Range(.List(.ListIndex, 1)).Offset(0, 2).Value Me.Range("K48").Value = _ Worksheets("マスタ").Range(.List(.ListIndex, 1)).Offset(0, 4).Value End With End Sub これをマスタのU列とW列を表示したい場合、どこを変えれば良いのでしょうか? 今はD列とF列が表示されております。

  • アクセスのイベント記述について。

    アクセスで登録ボタンをコントロールウィザードで作ったのですが、登録と同時にそのフォームを閉じるにはどうしたらよいでしょうか。現在の登録ボタンのイベント記述は下記のとおりです。よろしくお願いいたします。 Private Sub 登録_Click() On Error GoTo Err_登録_Click DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 Exit_登録_Click: Exit Sub Err_登録_Click: MsgBox Err.Description Resume Exit_登録_Click End Sub

  • access vba 構文の解読

    access vba 構文の解読 はじめまして先ほどaccess2003について質問させていただいたものです。以下の構文が先ほどの続きです。こちらも皆様のお力で構文を解読していただけないでしょうか。 すみません解読とは、構文の一行一行が何を示しているのか教えていただけると助かります。 よろしくお願いいたします。 ' Exit the application. Case conCmdExitApplication CloseCurrentDatabase ' Run a macro. Case conCmdRunMacro DoCmd.RunMacro rs![Argument] ' Run code. Case conCmdRunCode Application.Run rs![Argument] ' Open a Data Access Page Case conCmdOpenPage DoCmd.OpenDataAccessPage rs![Argument] ' Any other command is unrecognized. Case Else MsgBox "不明なオプションです。" End Select ' Close the recordset and the database. rs.Close HandleButtonClick_Exit: On Error Resume Next Set rs = Nothing Set con = Nothing Exit Function HandleButtonClick_Err: ' If the action was cancelled by the user for ' some reason, don't display an error message. ' Instead, resume on the next line. If (Err = conErrDoCmdCancelled) Then Resume Next Else MsgBox "コマンド実行中のエラーです。", vbCritical Resume HandleButtonClick_Exit End If End Function Private Sub メニュー終了_Click() On Error GoTo Err_メニュー終了_Click DoCmd.Close Exit_メニュー終了_Click: Exit Sub Err_メニュー終了_Click: MsgBox Err.Description Resume Exit_メニュー終了_Click End Sub Private Sub 終了_Click() On Error GoTo Err_終了_Click DoCmd.Quit Exit_終了_Click: Exit Sub Err_終了_Click: MsgBox Err.Description Resume Exit_終了_Click End Sub

  • ACCESSからEXCELの PasteSpecial でエラーになる

    ACCESSからEXCELを操作しています。 範囲コピー後、書式のみペーストしたいのですが、うまくいきません。 以下の PasteSpecial の行でエラーになります。 エラーメッセージは「Range クラスの PasteSpecial メソッドが失敗しました。」です。パラメータを付けないと全てがコピーされ正常に終わります。 パラメータをダブルクォートで囲っても駄目でした。 EXCELのマクロ出力そのままなのですが、書き方が悪いのでしょうか。 Dim oApp As Object Set oApp = CreateObject("Excel.Application") oApp.UserControl = True oApp.Workbooks.Open FileName:="format.xls" oApp.Range("A1:D4").Select oApp.Selection.Copy oApp.Range("C9").Select '↓エラーになる oApp.Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

専門家に質問してみよう