前提・実現したいこと
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
あなたの回答
tips
プレビュー