質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.49%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

0回答

1276閲覧

Application.CommandBarsがうまく開かない

SnowBallEffect

総合スコア28

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2019/09/10 02:20

前提・実現したいこと

VBA で2つのワークシートを比較して相違点をハイライトしたいと思います。
(例)Excel VBAを使っています。
■■な機能を実装中に以下のエラーメッセージが発生しました。

発生している問題・エラーメッセージ

Run-time error '-2147467259 (80004005)': Method 'ShowPopup' of object 'CommandBar' failed このエラーが2回目のApplication.CommandBars("Workbook Tabs").ShowPopupの後に出てきます。 Workbooks(wbkA).Activateの後に: Application.CommandBars("Workbook Tabs").ShowPopup Set ws1 = ActiveSheet ActiveSheet.Move Before:=ActiveWorkbook.Sheets(1) というコマンドを入れると問題なく進みますが、 Workbooks(wbkB).Activateの後に: Application.CommandBars("Workbook Tabs").ShowPopup Set ws2 = ActiveSheet ActiveSheet.Move Before:=ActiveWorkbook.Sheets(1) というほとんど同じコマンドを入れたら上記のエラーメッセージが出てきます。 デバッグが出てきて、F8を押し、コマンド一つずつ進めるとうまく行きます。スクリプトの始めからF8を順番に押していってもうまくいきます。不思議な現象です。 そのあとのコードは全てうまくいきます。

該当のソースコード

ExcelVBA

1Sub Button1_Click() 2 3Dim mycell As Range 4Dim mydiffs As Integer 5 6Dim ws1 As Worksheet 7Dim ws2 As Worksheet 8 9ChDir Range("B4") 10Title = "Select your Statestreet sheet" 11checkfile1 = Application.GetOpenFilename(, , Title) 12strfilename1 = Mid(checkfile1, InStrRev(checkfile1, "\") + 1) 13ThisWorkbook.Sheets("Sheet1").Range("B7") = strfilename1 14 15ChDir Range("B5") 16Title = "Select your check sheet" 17checkfile2 = Application.GetOpenFilename(, , Title) 18strfilename2 = Mid(checkfile2, InStrRev(checkfile2, "\") + 1) 19ThisWorkbook.Sheets("Sheet1").Range("B8") = strfilename2 20 21Dim fname As String 22Dim cname As String 23 24'filename 25fname = Range("B4") & Range("B7") 26'checksheetname 27cname = Range("B5") & Range("B8") 28 29 30'Workbooks.Open Filename:="\servername\" & Range("B7") & ".xlsx" 31Workbooks.Open Filename:=fname 32 33Workbooks("ITM Report.xlsm").Activate 34 35Application.AskToUpdateLinks = False 36Application.DisplayAlerts = False 37 38'Workbooks.Open Filename:="\servername\" & Range("B6") & ".xlsm" 39Workbooks.Open Filename:=cname 40'Worksheets("Checksheet").Activate 41 42Workbooks("ITM Report.xlsm").Activate 43 44Dim wbkA As String 45Dim wbkB As String 46 47wbkA = Range("B8") 48wbkB = Range("B7") 49 50Workbooks(wbkA).Activate 51 52Application.CommandBars("Workbook Tabs").ShowPopup 53Set ws1 = ActiveSheet 54ActiveSheet.Move Before:=ActiveWorkbook.Sheets(1) 55 56Workbooks(wbkB).Activate 57 58Application.CommandBars("Workbook Tabs").ShowPopup 59Set ws2 = ActiveSheet 60ActiveSheet.Move Before:=ActiveWorkbook.Sheets(1) 61 62 63'For each cell in sheet2 that is not the same in Sheet1, color it yellow 64 65 66'For Each mycell In Workbooks(wbkA).Worksheets("Summary").Range("A" & Rows.Count).End(xlUp).row 67For Each mycell In Workbooks(wbkA).Worksheets(1).UsedRange 68 'If Not mycell.Value = Workbooks(wbkB).Worksheets("1).Cells(mycell.row, mycell.Column).Value Then 69 If Not mycell.Value = Workbooks(wbkB).Worksheets(1).Cells(mycell.row, mycell.Column).Value Then 70 71 mycell.Interior.Color = vbYellow 72 mydiffs = mydiffs + 1 73 74 End If 75Next 76 77'Display a message box to demonstrate the differences 78MsgBox mydiffs & " differences found", vbInformation 79 80'Workbooks(wbkB).Sheets("Summary").Select 81 82End Sub

試したこと

Workbooks(wbkA).Activate と Workbooks(wbkB).Activateの間に10秒のpauseを入れましたが、それでもダメでした。Workbooks(wbkA).Activate と Workbooks(wbkB).Activateを別々のモジュールにしてもダメでした。

補足情報(FW/ツールのバージョンなど)

使っているOSはWindows 10 Enterprise v1803 64bit, Excel 365 1903 32 bit

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだ回答がついていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.49%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問