dポイントプレゼントキャンペーン実施中！

急いでいます！

Accessフォームから指定のExcelのセルへ転送する方法について

解決済

  • 質問者：Access苦手
  • 質問日時：
  • 回答数：6件

Accessフォームで入力したレコードにボタンをクリックすると指定のExcelのセルに転送されるようにしたいです。Excelファイルは既に用意してありますが今回はTEST用にファイルを作成しました。
ボタンをクリックしたときに以下のようにVBAを設定したところ、
6行目の部分で止まってしまいました。
このVBAはネットで調べてまねたものになります。ファイル名やセルだけ変更しました。
VBAド素人で原因がぜんぜんわからなかったので教えてください。
よろしくお願います。

Private Sub Ctl7F_Click()
Dim AppObj As Object 'Excel.Applicationオブジェクトの宣言
Dim WBObj As Object 'Excel.Workbookオブジェクトの宣言
Dim WsObj As Object 'Excel.WorkSheetオブジェクトの宣言

Dim strNewCell As String
Dim objRange As Range　　　※ここで止まってしまいました　　　　
Const xlCellTypeLastCell = 11

Dim FilePath As String

FilePath = Application.CurrentProject.Path & "TEST.xlsx"

Set AppObj = CreateObject("Excel.Application") '実行時バインディング
Set WBObj = AppObj.Workbooks.Open(FilePath) 'ワークブックを開く
Set WsObj = WBObj.Worksheets("Sheet1")
AppObj.Visible = True

Set AppObj = GetObject _
(, "Excel.Application")
Set WsObj = AppObj.Worksheets("Sheet1")
Set objRange = WsObj.UsedRange
objRange.SpecialCells(xlCellTypeLastCell).Activate

strNewCell = "A" & AppObj.ActiveCell.Row + 1
AppObj.Range(strNewCell).Activate


With AppObj.Range(strNewCell)
.Cells(3, 3) = Me![部課]
.Cells(4, 3) = Me![所属]
.Cells(3, 12) = Me![計測日]
.Cells(16, 13) = Me![外観正常]

End With


AppObj.DisplayAlerts = False
WBObj.Save 'ワークブックを保存する
WBObj.Close 'ワークブックを閉じる
AppObj.Quit
AppObj.DisplayAlerts = True

DoCmd.RunCommand acCmdSaveRecord
DoCmd.GoToRecord , , acNewRec

MsgBox "ACCESS Excel データ転送が完了しました "

End Sub

通報する

この質問への回答は締め切られました。

質問の本文を隠す

A 回答 (6件)

No.6ベストアンサー

  • 回答者： nicotinism
  • 回答日時：

>ただ転送自体がPC内にあるダウンロードにしか転送できない状態になってしまいました。


>AccessのVBAで転送先を指定する必要があるのでしょうか？
FilePath = Application.CurrentProject.Path & "\" & "TEST.xlsx" '※パスの修正
↑この行でAccessの自ACCDBファイルのあるフォルダを指定していますから
多分ですが「ダウンロード」フォルダにAccessファイルを置いて試しているのではないですか？
あなたの都合の良いように変更すれば…と思います。

>外観正常フィールドはYes/No型で設定しているのですが、
>Excelへ転送すると-1と表示されてしまいます。
AccessのYes/No型は内部データは、-1/0 で保存されていて
人間が分かりやすいようにYes/No や True/False と表示しているだけです。
なのでAccessは実際の値である -1/0 をExcelに渡しています。
そちらの都合の良い表示、Yes/No や ○/● とかに変更するには
.Cells(16, 13) = Me![外観正常] を
.Cells(16, 13) = iif(Me![外観正常] = -1,"Yes","No")
などとすればよろしいかと。
    • good
    • 0
    • 件
通報する
この回答へのお礼

回答ありがとうございます。
なるほどそういうことでしたか！
いろいろ教えていただきありがとうございました。
本当に助かりました。

通報する
お礼日時：2022/01/11 09:25

うーん・・・

No.5

  • 回答者： nicotinism
  • 回答日時：

こんな感じでは？



Private Sub Ctl7F_Click()
Dim AppObj As Object 'Excel.Applicationオブジェクトの宣言
Dim WBObj As Object 'Excel.Workbookオブジェクトの宣言
Dim WsObj As Object 'Excel.WorkSheetオブジェクトの宣言
'Dim RgObj As Object '※Rangeオブジェクト用に宣言
'Dim strNewCell As String
'Dim objRange As Range　　　※ここで止まってしまいました
Const xlCellTypeLastCell = 11 '不要では？

Dim FilePath As String

FilePath = Application.CurrentProject.Path & "\" & "TEST.xlsx" '※パスの修正

Set AppObj = CreateObject("Excel.Application") '実行時バインディング
Set WBObj = AppObj.Workbooks.Open(FilePath) 'ワークブックを開く
Set WsObj = WBObj.Worksheets("Sheet1")
'Set RgObj = WsObj.UsedRange '使用する場合はこんな風にセット

DoCmd.RunCommand acCmdSaveRecord '※ここでレコードの保存が必要
AppObj.Visible = True

'Set AppObj = GetObject _
'(, "Excel.Application")
'Set WsObj = AppObj.Worksheets("Sheet1") ’この3行は不要
'RgObj.SpecialCells(xlCellTypeLastCell).Activate '以下の3行も不要では？

'strNewCell = "A" & AppObj.ActiveCell.Row + 1
'AppObj.Range(strNewCell).Activate

With WsObj 'AppObj.Range(strNewCell)
.Cells(3, 3) = Me![部課]
.Cells(4, 3) = Me![所属]
.Cells(3, 12) = Me![計測日]
.Cells(16, 13) = Me![外観正常]
End With

AppObj.DisplayAlerts = False
WBObj.Save 'ワークブックを保存する
WBObj.Close 'ワークブックを閉じる
AppObj.Quit
AppObj.DisplayAlerts = True
Set WsObj = Nothing: Set WBObj = Nothing: Set AppObj = Nothing

DoCmd.GoToRecord , , acNewRec

MsgBox "ACCESS Excel データ転送が完了しました "
End Sub

なお、VB6でのお話ですがVBAでも参考になると思わます。
オートメーションにおける事前バインディングおよび実行時バインディングの使用
http://support.microsoft.com/kb/245115/ja

Excel のタスクを正常に終了できない現象
http://hanatyan.sakura.ne.jp/vbhlp/ExcelErr.htm
    • good
    • 0
    • 件
通報する
この回答へのお礼

回答ありがとうございました。
無事データの転送ができるようになりました！！！
ただ転送自体がPC内にあるダウンロードにしか転送できない状態になってしまいました。AccessのVBAで転送先を指定する必要があるのでしょうか？
また、外観正常フィールドはYes/No型で設定しているのですが、Excelへ転送すると-1と表示されてしまいます。これもVBA上で設定を変えないといけないのでしょうか？
いろいろ質問してしまい申し訳ございませんが教えていただけると幸いです。よろしくお願いいたします。

通報する
お礼日時：2022/01/10 11:47

No.4

  • 回答者： Qchan1962
  • 回答日時：

こんばんは


ACCESSからなので示されているコードの場合、すでにされている通り
Dim WsObj As Object 'Excel.WorkSheetオブジェクトの宣言　の様に
同じ行で
Dim objRange As Object 'Excel.Rangeオブジェクトの宣言
とすれば、解消されると思います。

当方ACCESSが無いので分かりませんが、事前バインディングRange型で
.SpecialCellsは追加されるのかな？
.SpecialCellsについてもAs Objectでコンパイルできると思います
頓珍漢な事を言ってたらごめんなさい。

あと、ご質問とは関係ないところですが、
1点になるのは、同じ個所の
objRange.SpecialCells(xlCellTypeLastCell).Activate
これはセル範囲をアクティブにするコードですが、Excelの場合、
オブジェクト上位にあるシートがアクティブである事が必要です。
言い換えると、開いた（取得した）ブックに2シートありSheet2が表示されている状態で保存されている場合、
Set WsObj = WBObj.Worksheets("Sheet1")
Set objRange = WsObj.UsedRange
objRange.SpecialCells(xlCellTypeLastCell).Activate
なのでSheet1が取得できないよ？エラーが返ります

勿論、開くブックは必ずSheet1しかないのなら良いのですが、、
WsObj.Activate　などを入れておく方が安心？かと思いました。
エラー対策などはこれからと言う事でしょうが、気になりましたので一応
    • good
    • 0
    • 件
通報する
この回答へのお礼

回答ありがとうございました。
無事設定できました。
本当に助かりました。

通報する
お礼日時：2022/01/11 09:26

No.3

例えば、変数WsObjですが、本来はWorksheet型で定義すべきところ、諸事情により、Object型で定義しているものと理解しています。


しかし、止まったところ？って、Range型で定義していますよね？
ここでも諸事情を考慮する必要があると思います。
諸事情とは、たぶん、No.1さんの言う通りかと。
    • good
    • 0
    • 件
通報する
この回答へのお礼

回答ありがとうございました。
本当に助かりました。

通報する
お礼日時：2022/01/11 09:26

No.2

Dim objRange As AppObj.Range



の宣言を

Set AppObj = CreateObject("Excel.Application") '実行時バインディング

より後ろでやるとかかな？
    • good
    • 0
    • 件
通報する
この回答へのお礼

回答ありがとうございました。
本当に助かりました。

通報する
お礼日時：2022/01/11 09:27

No.1

おそらくですけど、Excelを参照可能にするための参照設定をしてないんじゃないかな？



参考サイトに書いてなかった？
    • good
    • 0
    • 件
通報する

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

Q質問する（無料）

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

関連するカテゴリからQ&Aを探す

ページトップページトップ

Q質問する（無料）

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

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

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

おすすめ情報