Access (VBA)

Access VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 8 : Access 2016)
ACCESSからエクセル起動
投稿日時: 17/06/16 08:50:15
投稿者: 丘珠

ACCESSからブック1のシート(回答)を開きACCESSのフォーム上のテキスト1〜5までのデータをエクセルの指定セルA1、B5、C3、A3、B3へコピーしたいのですが方法が全く分かりません。
エクセルの保存場所は仮想ドライブ¥S:¥ABとなります
初心者ですよろしくお願いいたします。

回答
投稿日時: 17/06/16 10:37:56
投稿者: sk

引用:
ACCESSからブック1のシート(回答)を開き
ACCESSのフォーム上のテキスト1〜5までのデータを
エクセルの指定セルA1、B5、C3、A3、B3へコピーしたい

引用:
エクセルの保存場所は仮想ドライブ¥S:¥ABとなります

(フォームモジュール)
----------------------------------------------------------------------
'コマンドボタン[コマンドボタン名]の[クリック時]イベント
Private Sub コマンドボタン名_Click()
On Error GoTo Err_コマンドボタン名_Click
     
    Dim xlsApp As Object
    Dim xlsWorkbook As Object
    Dim xlsWorksheet As Object
     
    Dim strFolderPath As String
    Dim strFileName As String
    Dim strFullPath As String
 
    strFolderPath = "S:\AB\"
    strFileName = "ブック1.xlsx"
    strFullPath = strFolderPath & strFileName
 
    If Dir(strFullPath) = "" Then
        MsgBox "ファイルパス'" & strFullPath & "'の指定が正しくありません。", _
               vbExclamation, _
               "ファイル参照エラー"
        Exit Sub
    End If
     
    On Error Resume Next
    Set xlsApp = GetObject(, "Excel.Application")
     
    Select Case Err.Number
        Case 0
            '何もしない
        Case 429
            Err.Clear
            On Error GoTo Err_コマンドボタン名_Click
            Set xlsApp = CreateObject("Excel.Application")
            xlsApp.Visible = True
        Case Else
            GoTo Err_コマンドボタン名_Click
    End Select
     
    On Error Resume Next
    Set xlsWorkbook = xlsApp.Workbooks(strFileName)
      
    Select Case Err.Number
        Case 0
            On Error GoTo Err_コマンドボタン名_Click
            If xlsWorkbook.FullName <> strFullPath Then
                MsgBox "'" & strFolderPath & "'とは別のフォルダにある" & _
                       "'" & strFileName & "'と同名のファイルが開かれています。" & vbCrLf & _
                       "現在開かれている'" & strFileName & "'を閉じてから再度実行して下さい。", _
                       vbExclamation, _
                       "エラー"
                Set xlsWorkbook = Nothing
                Set xlsApp = Nothing
                Exit Sub
            End If
        Case 9
            Err.Clear
            On Error GoTo Err_コマンドボタン名_Click
            Set xlsWorkbook = xlsApp.Workbooks.Open(strFullPath)
        Case Else
            GoTo Err_コマンドボタン名_Click
    End Select
     
    Set xlsWorksheet = xlsWorkbook.Worksheets("回答")
     
    With xlsWorksheet
        .Range("A1") = Me![テキスト1]
        .Range("B5") = Me![テキスト2]
        .Range("C3") = Me![テキスト3]
        .Range("A3") = Me![テキスト4]
        .Range("B3") = Me![テキスト5]
    End With
         
    xlsApp.UserControl = True
     
Exit_コマンドボタン名_Click:
On Error Resume Next
     
    Set xlsWorksheet = Nothing
    Set xlsWorkbook = Nothing
    Set xlsApp = Nothing
     
    Exit Sub
 
Err_コマンドボタン名_Click:
         
    MsgBox Err.Number & ": " & Err.Description, _
           vbCritical, _
           "実行時エラー(" & Me.Name & ".コマンドボタン名_Click)"
         
    Resume Exit_コマンドボタン名_Click
End Sub
----------------------------------------------------------------------
 
以上のような感じでしょうか。

投稿日時: 17/06/17 17:05:57
投稿者: 丘珠

skさん連絡が遅くなりすみません。
いただいた、コードで理想的に動きましたありがとうございます。
今回いただいたコードに追加で、フォーム上のテキストボックス(年式)に半角数字で仮に
16.5と入力されている数字を下記コードに
With xlsWorksheet
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Range("A1") = Me![テキスト1]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Range("B5") = Me![テキスト2]
    .Range("S11") = Me![年式] 、Mid(年式, 1, 2)←16(年度です)
    .Range("T11") = Me![年式] 、Mid(年式, 1, 3)←5 (月で表示は1、2,3・・11,12表示です)
エクセルS11、T11ともにエラーがでます。
もう一度アドバイスをお願いします

投稿日時: 17/06/17 17:08:40
投稿者: 丘珠

[quote="丘珠"]skさん連絡が遅くなりすみません。
いただいた、コードで理想的に動きましたありがとうございます。
今回いただいたコードに追加で、フォーム上のテキストボックス(年式)に半角数字で仮に
16.5と入力されている数字を下記コードに
With xlsWorksheet
    .Range("A1") = Me![テキスト1]
    .Range("B5") = Me![テキスト2]
    .Range("S11") = Me![年式] 、Mid(年式, 1, 2)←16(年度です)
    .Range("T11") = Me![年式] 、Mid(年式, 1, 3)←5 (月で表示は1、2,3・・11,12表示です)
エクセルS11、T11ともにエラーがでます。
もう一度アドバイスをお願いします

回答
投稿日時: 17/06/19 10:14:57
投稿者: Suzu

丘珠さんこんにちは。
 

丘珠 さんの引用:
エクセルS11、T11ともにエラーがでます。

 
どんなエラーとなるのか、明示しましょうね。
 
 
提示頂いたコードでは、 S11,T11 のセルに表示されるエラーの前にコンパイルエラーが出ますよね。
引用:
.Range("S11") = Me![年式] 、Mid(年式, 1, 2)←16(年度です)
.Range("T11") = Me![年式] 、Mid(年式, 1, 3)←5 (月で表示は1、2,3・・11,12表示です)

 
コードは正確にコピペしてください。
 
 Me![年式] 、Mid(年式, 1, 3)
          ^^^ この点以降はコンパイルエラーとなりますよね。 全角数字も。。
また、Mid関数内の「年式」 変数宣言の無い 変数として扱われてしまします。
きちんと、フォーム上の年式である事をExcelに判る様にしてあげましょう。
 
 
sk さん こんにちは。
エラートラップがちょっと特殊かなと感じたので、意図があるのか伺いたいです。
・ 最初で、On Error GoTo Err_コマンドボタン名_Click としていますが
   GetObjectまでエラーとなりそうな部分がありません。
   その後は、ResumeNextなので、 最初のOn Error の意図は何でしょうか。
 
・xlsApp.Workbooks(strFileName) の後の、Err 0 にて
   On Error GoTo Err_コマンドボタン名_Click には行かず、
   そこで、Exit Sub としているのは、ワークシートを参照していないからでしょうか。
 
すみません。細かい部分で。。 お時間がある時で構いません。

回答
投稿日時: 17/06/19 11:36:18
投稿者: sk

丘珠 さんの引用:
今回いただいたコードに追加で、フォーム上のテキストボックス(年式)に半角数字で仮に
16.5と入力されている数字を下記コードに
With xlsWorksheet
    .Range("A1") = Me![テキスト1]
    .Range("B5") = Me![テキスト2]
    .Range("S11") = Me![年式] 、Mid(年式, 1, 2)←16(年度です)
    .Range("T11") = Me![年式] 、Mid(年式, 1, 3)←5 (月で表示は1、2,3・・11,12表示です)
エクセルS11、T11ともにエラーがでます。

(そこで Mid 関数を用いるのが妥当と言えるかどうかについてはひとまず置くとして)
こちらについてはまず Suzu さんのご指摘に対してお答え下さい。
 
Suzu さんの引用:
また、Mid関数内の「年式」 変数宣言の無い 変数として扱われてしまします。
きちんと、フォーム上の年式である事をExcelに判る様にしてあげましょう。

厳密に言えば Me キーワードを省略出来る場合もありますので、
現時点では「そうだとは断定しかねる」とも思いますが。
 
Suzu さんの引用:
エラートラップがちょっと特殊かなと感じたので、意図があるのか伺いたいです。
・ 最初で、On Error GoTo Err_コマンドボタン名_Click としていますが
   GetObjectまでエラーとなりそうな部分がありません。
   その後は、ResumeNextなので、 最初のOn Error の意図は何でしょうか。

後からコードに手を加えられる可能性」を考慮した上での、
私なりのコーディングにおける作法のようなものに過ぎません。
 
例えば、最初の On Error Resume Next ステートメントより
前の行に何らかのコードの追加/改変が行われたとして、
もし改変後のコードを実行した際に実行時エラーが発生した場合であっても、
必ずエラー処理に飛ばすようにしている、というだけです。
 
Suzu さんの引用:
・xlsApp.Workbooks(strFileName) の後の、Err 0 にて
   On Error GoTo Err_コマンドボタン名_Click には行かず、
   そこで、Exit Sub としているのは、ワークシートを参照していないからでしょうか。

引用:
Set xlsWorkbook = xlsApp.Workbooks(strFileName)
 
Select Case Err.Number
    Case 0
        On Error GoTo Err_コマンドボタン名_Click
        If xlsWorkbook.FullName <> strFullPath Then
            MsgBox "'" & strFolderPath & "'とは別のフォルダにある" & _
                   "'" & strFileName & "'と同名のファイルが開かれています。" & vbCrLf & _
                   "現在開かれている'" & strFileName & "'を閉じてから再度実行して下さい。", _
                   vbExclamation, _
                   "エラー"
            Set xlsWorkbook = Nothing
            Set xlsApp = Nothing
            Exit Sub
        End If

( Case 0 のフローに入って真っ先にエラートラップの設定を
 行なっていますので、その後の If ステートメントでの判定結果が True となった時に
 「 GoTo ステートメントで Err_コマンドボタン名_Click 行には飛ばさず」
 という意味であると、とりあえず解釈しましたが)
 
Err オブジェクトの Number プロパティの値が 0 である
(=実行時エラーが発生していない)流れにおいて、
実行時エラーに関する情報をメッセージボックスに表示させる
エラー処理に飛ばす意味も必要もないからです。
 
引用:
Err_コマンドボタン名_Click:
          
    MsgBox Err.Number & ": " & Err.Description, _
           vbCritical, _
           "実行時エラー(" & Me.Name & ".コマンドボタン名_Click)"
          
    Resume Exit_コマンドボタン名_Click
End Sub

投稿日時: 17/06/19 11:39:57
投稿者: 丘珠

Suzuさん
年度の2文字は取り出しできたのですが、月表示はうまくいきません。
Right([年式], 2)を使ってセル表示されるのは0.6(16.6の場合)と表示されてしまいます。
いろいろ試してみたのですがうまくいきません。
アドバイスをお願いします。

回答
投稿日時: 17/06/19 11:53:10
投稿者: sk

引用:
年度の2文字は取り出しできたのですが、月表示はうまくいきません。
Right([年式], 2)を使ってセル表示されるのは0.6(16.6の場合)と表示されてしまいます。

"." まで含めてしまうと "." が小数点として扱われて
".6" という文字列が( Excel 側で) 0.6 という浮動小数点型の
数値データとして解釈され、暗黙的に型変換されかねません。
 
引用:
Mid(年式, 1, )

また、[年式]の値の左から 1 文字目以降の 3 文字を抜き出したら
"16." となりますので、これも正しくありません。
 
[年式]の値の左から 4 文字目以降の全ての文字列
抜き出したい場合は、以下のようにして下さい。
 
-----------------------------------------------------
 
Mid(Me![年式], 4)
 
-----------------------------------------------------
(第 3 引数 Length の指定を省略する)

回答
投稿日時: 17/06/19 12:30:27
投稿者: Suzu

丘珠さん
  Midで切出す前に、入力者が意図した形で入力してくれているか等まで判定する事を考慮するなら
 年と月、テキストボックスを分けて、それぞれ判定した方が楽ですよ。
 また、判定ではなく、入力規則で縛ってしまうという方法もあります。
 
 
 
skさん
 

sk さんの引用:
「後からコードに手を加えられる可能性」を考慮した上での、
私なりのコーディングにおける作法のようなものに過ぎません。

 
そうなんですね。
確かに、改変された時にはエラートラップがどうなるか判りませんからね。
承知しました。
 
 
Suzu さんの引用:
・xlsApp.Workbooks(strFileName) の後の、Err 0 にて
   On Error GoTo Err_コマンドボタン名_Click には行かず、
   そこで、Exit Sub としているのは、ワークシートを参照していないからでしょうか。

 
すみません。書き間違いです。
Err_コマンドボタン名_Click ではなく、
【Exit_コマンドボタン名_Click に行かず Exit Sub としている。】が正しいです。
 
出口 Exit Sub を書く部分は、 一か所にしておいて フローを判り易くした方が 好ましい。
と認識していました。
 
sk さんの引用:

Suzu さんの引用:
また、Mid関数内の「年式」 変数宣言の無い 変数として扱われてしまします。
きちんと、フォーム上の年式である事をExcelに判る様にしてあげましょう。
 
厳密に言えば Me キーワードを省略出来る場合もありますので、
現時点では「そうだとは断定しかねる」とも思いますが。

 
そうですね。 今回は、「内容が違う」とかではなく、「エラー」との事だったので、
Mid関数の引数違いではなく、変数を参照できない事によるエラーなのかな、、と考えました。

投稿日時: 17/06/19 14:57:50
投稿者: 丘珠

皆さんありがとうございます。
おかげさまで、希望通りできました。
年月を分けて対応したほうが今となってはわかるのですが2万件ほどデータがあるためMID7関数が楽との思いでした。
ありがとうございます。