vba 2003のボタン実行がうまくいかない

前へ 次へ
このQ&Aのポイント
  • Excel VBAを使用して2003年のボタン実行がエラーで止まってしまう問題が発生しています。
  • 2003年ではフォームのボタンに同じマクロを割り当てた場合にエラーが発生しますが、2010年では問題ありません。
  • エラーの原因については、SendKeys関数が影響している可能性がありますが、ファイルにパスワードが設定されているため、パスワード入力を無視し続行するためにSendKeys関数を使用しています。なぜ2003年のボタン実行だけがエラーで停止するのか、詳しい方からのアドバイスをお待ちしています。
回答を見る
  • ベストアンサー

vba 2003のボタン実行がうまくいかない

エクセルVBAについて質問があります。 使用環境はExcel2003～2010です。 フォームから実行をするとうまくいくのですが、 フォームのボタンに同じマクロを割り当てたものをクリックすると 2003ではとまってしまいます。 2010ではどちらも完結し、問題ありません。 止まるところまで中身を張り付けておきます。 Sub BookAndSheetCall() Dim Flag As Boolean Dim myPath As String, msg As String, shName As String Dim wb_A As Workbook, Sh As Worksheet myPath = "なんとかかんとか\Book1.xlsm" 'なんとかかんとかはネットワーク上です If myPath = "False" Then Exit Sub With Application Application.SendKeys ("{ESC}"), True Application.SendKeys ("{ENTER}"), True Application.SendKeys ("{NumLock}"), 1 End With Set wb_A = Workbooks.Open(myPath)　'ここでエラーがでてしまいます　 shName = "Sheet1" Sheets("Sheet1").Select ActiveWindow.SelectedSheets.Visible = False wb_A.Worksheets(shName).Copy before:=ThisWorkbook.Sheets(1) 　　　　続く・・・ 止まる原因の手前にある「SendKeys」が悪さをしているような感じもするのですが、 Book1.xlsmにはパスワードが設定されているので、開くとパスワードを入力するメッセージが表示されるのですが、それを無視して続行するため、EscやEnterの入力が必要なので入れてます。 同じvbaで、なぜ2003のボタン実行だけがエラーでとまってしまうのでしょうか？ お詳しい方、ご教授頂ければ幸いです。 ちなみに、私はvbaは初心者です。 色々参考にしながら、ここまで作っているというレベルです。 よろしくお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • mt2008
  • ベストアンサー率52% (885/1701)
回答No.3

ANo.2です。 出始めのころの互換パックにはパスワード付きのブックを開く際に不具合が出ることが有ったようです。 インストールされている互換パックは最新版（Ver4)でしょうか。

yamayama456
質問者

お礼

互換パックのバージョンは気にしていませんでした！ 早速チェックしてみます。 ありがとうございます。

その他の回答 (2)

  • mt2008
  • ベストアンサー率52% (885/1701)
回答No.2

拡張子「xlsm」のブックを開こうとしていますが、xlsmはExcel2007以降で使用する拡張子です。 Excel2003の場合、そのままでは開けません。 互換パックはインストールされていますか？

yamayama456
質問者

お礼

互換パックはインストールされていますか？ はい。 インストールしています。 ですので、開くことは可能です。

  • suzukikun
  • ベストアンサー率28% (372/1325)
回答No.1

こういう質問をするときはエラーコード・OSのバージョンなどを書かないと適切な回答が得られませんよ。 一応検索してみると2003とVistaではエラーが出るようです。 http://support.microsoft.com/kb/931136/ja

yamayama456
質問者

お礼

エラーが出てしまうものなのかもしれないんですね。 教えていただいたサイトをチェックしてみます。 情報ありがとうございます。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • VBAでブック名の拡張子を除去してシートにコピー

    VBA初心者でコード作成で困っております。 下記の通りコードを組みましたが、シート名をブック名に変更して 保存したいのですが、このコードですと拡張子までついてしまいます。 拡張子を除去するためにはどうすればよいでしょうか？ アドバイス宜しくお願い致します。 Sub test() 'シート名の変更 Dim MyPath As String Dim MyFile As String Dim Wb As Workbook MyPath = "C:\TEST\" MyFile = Dir(MyPath & "*.xlsx") Do While MyFile <> "" Set Wb = Workbooks.Open(MyPath & MyFile) ActiveSheet.Name = ActiveWorkbook.Name Application.DisplayAlerts = False Wb.Save Application.DisplayAlerts = True Wb.Close (False) MyFile = Dir() Loop End Sub

  • VBAでBOOKを開かずにプロパティ変更

    エクセル2013です。 特定のフォルダ内のエクセルのBOOKのプロパティの作成者をすべて変えようと思います。 いろいろ試して、以下のコードでできるようになりました。 しかし、下記のコードではいちいちファイルを開かなくてはなりませんのでサイズが大きかったり、数が多いと結構時間がかかります。 手作業でファイルのプロパティを変えるときは、エクスプローラで右クリックすれば開かなくとも簡単にできます。VBAでもファイルを開かずにプロパティを変更するにはどうすればよいのでしょうか？お教えいただければ幸いです。 Sub TEST20190710() 　　Dim myFdr As String, fnm As String 　　Dim wb As Workbook 　　Dim n As Long 　　Const NEW_AUTHOR As String = "emaxemax" 　　 　　Application.ScreenUpdating = False 　　Application.EnableEvents = False 　　myFdr = "C:\Users\User\Documents\TEST01" 　　fnm = Dir(myFdr & "\*.xls?") 　　Do Until fnm = Empty 　　　　Set wb = Workbooks.Open(myFdr & "\" & fnm) 　　　　Application.DisplayAlerts = False 　　　　wb.BuiltinDocumentProperties("Author").Value = NEW_AUTHOR 　　　　wb.Close SaveChanges:=True 　　　　Application.DisplayAlerts = True 　　　　n = n + 1 　　　　fnm = Dir 　　Loop 　　Application.ScreenUpdating = True 　　Application.EnableEvents = True 　　MsgBox n & "件のブックを処理しましました。", vbInformation End Sub

  • EXCEL　VBA　で他のアプリケーションを開く方法について

    EXCEL　VBAで他のアプリケーションを開く方法について教えていただきたいことがあります。 現在開いているエクセルのブックと同じフォルダにある、"AAA"という名称のsqc形式のファイル(EAST社のSkyLink Ver9.0のコマンドファイルです）をVBAで開く。 SHELL関数で開くと思っていたのですが、 Sub Test() Dim MyPath As String, MyTask As Double MyPath = ActiveWorkbook.Path & "\" MyTask = Shell(MyPath & "AAA.sqc") SendKeys "%FO", True End Sub とすると 「プロシージャの呼び出し、または引数が不正です」 というメッセージが出てしまいます。 如何せんSHELL関数を使うのが初めてでして、色々調べても どうしても解決策にたどり着きません。 どうぞよろしくお願いいたします。

  • エクセルVBAで読み取りパスワード回避

    エクセル2010です。 以下のコードで任意のフォルダ内のエクセルBOOKから所定のデータを取得できます。 しかし、指定フォルダ内に読み取りパスワードが設定されたものがあると、開くことができずに止まってしまいます。 読み取りパスワードが同一で、事前に分かっていればコードにPassword:="AAAABBBB"　などと書き入れればいいと思うのですが、事前にはわかりませんし、パスワードもそれぞれ異なります。 そこで、開けなかった場合には、そのBOOKを飛ばしてすすみ、別シートに飛ばしたBOOK名を記録しておきたいのです。 （BOOK作成者にあとからパスワードを聞くため） しかし、残念ながらどのように書けばいいのか思いつきません。 ご指導いただければ幸いです。 Sub TEST001() 　　Dim wb(1) As Workbook 　　Dim ws(1) As Worksheet 　　Dim myFdr As String, fn As String 　　Dim i As Long 　　With Application.FileDialog(msoFileDialogFolderPicker) 'フォルダ指定 　　　　If .Show = True Then 　　　　　　 myFdr = .SelectedItems(1) 　　　　Else 　　　　　　Exit Sub 　　　　End If 　　End With 　　Application.ScreenUpdating = False '画面更新を一時停止 　　Set wb(0) = ThisWorkbook 'このコピー先ブックをwb(0)とする。 　　Set ws(0) = wb(0).Sheets(1) 'wb(0)の１枚目のシートをws(0)とする。 　　fn = Dir(myFdr & "\*.xls*") 'フォルダ内のExcelブックを検索 　　Do Until fn = Empty '全て検索 　　　　Application.EnableEvents = False 　　　　Set wb(1) = Workbooks.Open(myFdr & "\" & fn, UpdateLinks:=False, ReadOnly:=True) 'そのブックを開きwb(1)とする。 　　　　Set ws(1) = wb(1).Worksheets(1) 　　　　i = i + 1 　　　　ws(0).Cells(i, "A").Value = ws(1).Range("B2") 'ws(0)に転記 　　　　ws(0).Cells(i, "B").Value = wb(1).Name 　　　　ws(0).Cells(i, "C").Value = ws(1).Name 　　　　wb(1).Close (False) '保存せず閉じる 　　　　Application.EnableEvents = True 　　　　fn = Dir 'フォルダ内の次のExcelブックを検索 　　Loop '繰り返す 　　Application.ScreenUpdating = True '画面更新停止を解除 　　MsgBox i & "個取得" End Sub

  • VBAでご相談です！

    Excel2010使用。 VBA初心者です。 VBAでご相談させて下さい。 複数のファイルを１つにまとめる 作業をしたいと思い、ググったところ あるサイトで下記のコードを見つけました。 ただ、このコードでは、ファイルをダイアログから 選択する形になります。 これを、ファイルを指定した状態で実行させたいと思い、 自分で試してみたのですが、上手くいきませんでした。 同一フォルダ内には４つのファイルがあり、全て同じ様式の シートが複数あります。ただ、フォルダ名が毎月変更になります。 この同一フォルダ内のデータの中の特定のシートを一つのシートに まとめたいと考えているのですが、可能でしょうか？ 可能であれば、アドバイスいただけるとありがたいです。 Sub sample() Dim myPath As String Dim wb_A As Workbook, wb_B As Workbook Dim i As Long, s As Long myPath = Application.GetOpenFilename(("Excel ファイル (*.xls), *.xls"), , "データを蓄積するブックを選択して下さい。") If myPath = "False" Then Exit Sub Set wb_A = Workbooks.Open(myPath) myPath = Application.GetOpenFilename(("Excel ファイル (*.xls), *.xls"), , "データを取得するブックを選択して下さい。") If myPath = "False" Then Exit Sub Set wb_B = Workbooks.Open(myPath) With wb_B For i = 1 To .Worksheets.Count 'wb_Bループ For s = 1 To wb_A.Worksheets.Count 'wb_Aループ '同じ名前のシートがあるとき データコピー If .Worksheets(i).Name = wb_A.Worksheets(s).Name Then .Worksheets(i).Range("A1").CurrentRegion.Copy _ wb_A.Worksheets(i).Range("A65536").End(xlUp).Offset(1) Exit For End If '同じ名前のシートが無いとき シートコピー If s = wb_A.Worksheets.Count Then .Worksheets(i).Copy Before:=wb_A.Sheets(1) End If Next s Next i wb_B.Close False MsgBox "完了" End With End Sub ※長文、説明下手で申し訳ありませんが よろしくお願いします。 ＜参考URL＞ 　　http://www.excel.studio-kazu.jp/kw/20040709212700.html

  • エクセルVBAでファイル作成

    エクセルVBAで、データをフィルタで抽出し、別なBOOKの指定シートに転記し、名前をつけて保存したいのです。一応、下記のコードでテストは成功しました。 しかし下記コードでは1回ごとにデータの転記先を開かなくてはなりません。 処理する件数が多いので、できればいちいち新たに開き直さなくともよい方法はないでしょうか？ 最初から開いておいて、転記後名前をつけて保存すると、開いていたファイルが閉じてしまい、うまくいきません。 別BOOKでなく別シートに転記して、そのシートをMoveして別ファイル保存ならわかるのですが、今回はどうしても別BOOKに転記しなければなりません。 よろしくお願いします。 Option Explicit Sub データ分割転記() 　　Dim myPth As String, fname As String 　　Dim myRng As Range, myC As Range 　　Dim i As Long, x As Long 　　Dim wb(2) As Workbook 　　Dim ws As Worksheet 　　Dim t As Single 　　t = Timer 　　Set wb(0) = ThisWorkbook 　　myPth = wb(0).Path 　　With wb(0).Sheets("Key") 　　　　Set myRng = .Range("A2", .Range("A2").End(xlDown)) 'KeyData 　　End With 　　 　　For Each myC In myRng 　　　　Application.EnableEvents = False 　　　　Set wb(1) = Workbooks.Open(Filename:=myPth & "\20150806TEST.xlsm") 　　　　Set ws = wb(1).Sheets("List") 　　 　　　　With wb(0).Sheets("DATA") 　　　　　　.Range("A1:J1").AutoFilter Field:=4, Criteria1:=myC.Value 　　　　　　.Range("A2", .Range("A2").SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy ws.Range("A9") 　　　　　　.ShowAllData 　　　　End With 　　　　With ws 　　　　　　x = .Cells(Rows.Count, "A").End(xlUp).Row 　　　　　　myC.Offset(, 2).Value = x　'行数確認 　　　　　　.Range("A9").Value = 1 　　　　　　If x > 9 Then 　　　　　　　　.Range("A9").AutoFill Destination:=.Range("A9:A" & x), Type:=xlFillSeries '連番 　　　　　　End If 　　　　End With 　　　　wb(1).SaveAs Filename:=myPth & "\作成ファイル\" & myC.Value & ".xlsm" 　　　　wb(1).Close (False) 　　　　Application.EnableEvents = True 　　　　i = i + 1 　　Next 　　MsgBox i & "件を完了" _ 　　& vbCrLf & Timer - t & " Sec." End Sub ＊Application.EnableEvents = False を使っているのば別BOOKが持つイベントマクロを作動させないためです。

  • エクセルVBA　ブック間のコピー

    選択したテキストファイルをエクセルで開いたコピーし、 もう一つ開いたエクセルファイルにペーストするというマクロをVBAで 作成していますが、つまずいてしまいました。 ----------------------------------- Dim wb1 As String Dim wb2 As String Sub Opentxt() wb1 = Application.GetOpenFilename("テキストファイル,*.txt") If wb1 <> "False" Then Workbooks.OpenText Filename:=wb1, DataType:=xlDelimited, comma:=True End If End Sub Sub Copy() Dim LastRow As Long wb2 = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") If wb2 <> "False" Then Workbooks.Open wb2 LastRow = wb2.Sheets("一覧表").Range("A" & Rows.Count). End(xlUp).Row wb2.Sheets("一覧表").Range("A5:A" & lastRow).Copy _ wb1.Sheets("Sheet1).Range("B33") End If End Sub ----------------------------------- Opentxtの方は問題ないですが、Copyの方を実行すると wb1とwb2で引っかかって「コンパイルエラー/ 修飾子が不正です」と 表示されて、エラーになってしまいます。 この場合変数の型などがおかしいのでしょうか？ excel2007を使用しています。 よろしくお願いします。

  • エクセルVBAで、ある条件の時

    お世話になります。 エクセルVBAで次のようなことをしたいのですが方法を教えてください。 formフォルダにあるすべてのファイルについて、A1セルが「0」でないとき、 A4:B7及びA9:B12の中で日付が入っている行の日付と内容を、ActiveWorksheetのB列、C列にレコードとして取り出したいのです。 （A列はナンバリングになります） --------formフォルダの中にあるブック--------- 　　A　　B 1　23 2 3　日付　内容　　　'この行は固定です 4　5/13　あああ 5　5/17　いいい 6 7 8　日付　内容　　　'この行は固定です 9　5/16　ううう 10　5/12　えええ 11 12　5/10　おおお ---ThisWorkbook（前に助けていただいたコードです）--- Sub data_torikomi2() 　　Dim wb As Workbook 　　Dim Fn As String 　　Dim myPath As String 　　Dim dbBkSh As Worksheet 　　Dim i As Long 　　For Each wb In Workbooks 　　　　If wb.Name <> ThisWorkbook.Name And _ 　　　　InStr(1, wb.FullName, "form\", 1) > 0 Then 'formを検索 　　　　　　wb.Close '閉じる 　　　　End If 　　Next wb 　　myPath = ThisWorkbook.Path & "\" 　　Set dbBkSh = ThisWorkbook.Worksheets("一覧表") 　　　　　　　　　Range("4:1000").Clear '全データ削除 　　Fn = Dir(myPath & "form\*.xls") 　　i = 1 　　'画面のちらつきを抑える 　　Application.ScreenUpdating = False 　　Do Until Fn = "" 　　　　If Fn <> ThisWorkbook.Name Then 　　　　　　With Workbooks.Open(myPath & "form\" & Fn, , True) 　　　　　　　　dbBkSh.Range("A3").Offset(i, 0).Value = i 　　　　【★たぶんこの部分に入るものです★】 　　　　　　　　.Close False 　　　　　　　　i = i + 1 　　　　　End With 　　　　End If 　　　　Fn = Dir() 　　Loop 　　Application.ScreenUpdating = True 　　Set dbBkSh = Nothing End Sub ご教示よろしくお願いします。

  • VBA VLOOKUP 別のファイルを参照

    VBA VLOOKUP 別のファイルを参照 いつもこちらでお世話になっている者です。 VBAの勉強をしております。 別のファイルからVLOOKUPで値を参照したいのですが、 範囲を指定してみましたが、 「worksheetFunctionクラスのVlookupプロパティを参照できません」 とのメッセージが出てしまいます。 なお、値は空白になる行もありますので、 if関数で回避してみましたがうまくいきません。 いろいろ試しましたが、何度やってもうまくいかないので こちらに質問させていただきました。 お詳しい方、ご伝授いただければ助かります。 よろしくお願い致します。 環境はExcel2007です。 Sub sample() Dim 範囲 As Range Dim wb As Workbook, wb2 As Workbook Dim r As Integer,intRow As Integer Workbooks.Open Filename:="***.xlsm" Set wb = ThisWorkbook Set wb2 = ActiveWorkbook Set 範囲 = wb2.Sheets("PvtSht2").Range("Database3") r = wb.Sheets("sheet1").Range("A28:N28").End(xlToRight).ColumnintRow = 3 With wb.Sheets("sheet1") Do Until .Cells(intRow, 1).Value = "" .Cells(intRow, (r + 1)) = Application.WorksheetFunction.If((Application.WorksheetFunction.VLookup(Cells(intRow, 1), 範囲, 2, False)) = 0, "", Application.WorksheetFunction.VLookup(Cells(intRow, 1), 範囲, 2, False)) intRow = intRow + 1 Loop End With End sub

  • エクセルVBAでブックを開くと処理が終わってしまう

    VBA初心者なのですが、VBAでエクセルブックを開くとVBAの処理が終わってしまいます。理由がわからないのでアドバイスをお願いします。なお、止まってしまう箇所にコメントを入れプログラムを下記しました。また、4000字以上質問できないためプログラムの途中までしか書かれていません。そのため、余分な宣言が多数ありますが無視してください。よろしくお願いいたします。 Option Base 1 Sub 健康診断の郵送() Dim kyoNum() As String Dim b_name As String Dim a_name() As Variant Dim b_address As String Dim a_address() As Variant Dim mailNum() As Variant Dim place() As String Dim banchi() As String Dim ken() As String Dim Adr As String Dim AdrLen As Integer Dim i, j, k, cnt, l, m As Integer Dim ChrCode As Integer Dim cell As Range Dim Book1 As String Dim wb As Workbook Dim Book1_Path As String Dim flag As Boolean 'セルのクリア ThisWorkbook.ActiveSheet.Cells.ClearComments 'セルのプロパティを設定をする With ThisWorkbook.ActiveSheet.Columns("A:B") .ShrinkToFit = True .NumberFormatLocal = "@" .ColumnWidth = 45 End With 'カレントディレクトリのチェンジ(Windows2000以降) CreateObject("WScript.Shell").CurrentDirectory = ThisWorkbook.Path '簡易名称Book1にする Book1 = "Book1.xlsx" 'パスを取得する Book1_Path = ThisWorkbook.Path & "\" & Book1 If Dir(Book1_Path) = "" Then MsgBox "Book1.xlsxファイルが存在しません。", vbExclamation End If '同名ブックのチェック For Each wb In Workbooks If wb.Name = Book1 Then MsgBox "健康診断の郵送.xlsmはBook1を開こうとしています" _ & vbCrLf & "Book1を閉じて再実行してください", vbExclamation Exit Sub End If Next wb Application.ScreenUpdating = False '画面の更新を止める Workbooks.Open Book1_Path '＊＊＊＊＊←ここで処理が終わってしまう＊＊＊＊＊ 'ブック名を指定して非表示 Application.Windows("Book1.xlsx").Visible = False '後方検索でBook1.xlsxの入力済みセルの行数と列数を取得 With Workbooks("Book1.xlsx").ActiveSheet.UsedRange Book1_MaxRow = .Find("*", , xlValues, , xlByRows, xlPrevious).Row - 2 'データ入力済み行数取得 End With Application.ScreenUpdating = True Workbooks("Book1.xlsx").Activate j = 1 ReDim kyoNum(Book1_MaxRow) ReDim a_name(Book1_MaxRow) ReDim a_address(Book1_MaxRow) ReDim mailNum(Book1_MaxRow) ReDim ken(Book1_MaxRow) ReDim place(Book1_MaxRow) ReDim banchi(Book1_MaxRow)

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する