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

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

ただいまの
回答率

88.09%

Application.CommandBarsがうまく開かない

受付中

回答 0

投稿

  • 評価
  • クリップ 0
  • VIEW 1,512

score 24

前提・実現したいこと

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を順番に押していってもうまくいきます。不思議な現象です。

そのあとのコードは全てうまくいきます。

該当のソースコード

Sub Button1_Click()

Dim mycell As Range
Dim mydiffs As Integer

Dim ws1 As Worksheet
Dim ws2 As Worksheet

ChDir Range("B4")
Title = "Select your Statestreet sheet"
checkfile1 = Application.GetOpenFilename(, , Title)
strfilename1 = Mid(checkfile1, InStrRev(checkfile1, "\") + 1)
ThisWorkbook.Sheets("Sheet1").Range("B7") = strfilename1

ChDir Range("B5")
Title = "Select your check sheet"
checkfile2 = Application.GetOpenFilename(, , Title)
strfilename2 = Mid(checkfile2, InStrRev(checkfile2, "\") + 1)
ThisWorkbook.Sheets("Sheet1").Range("B8") = strfilename2

Dim fname As String
Dim cname As String

'filename
fname = Range("B4") & Range("B7")
'checksheetname
cname = Range("B5") & Range("B8")


'Workbooks.Open Filename:="\\servername\" & Range("B7") & ".xlsx"
Workbooks.Open Filename:=fname

Workbooks("ITM Report.xlsm").Activate

Application.AskToUpdateLinks = False
Application.DisplayAlerts = False

'Workbooks.Open Filename:="\\servername\" & Range("B6") & ".xlsm"
Workbooks.Open Filename:=cname
'Worksheets("Checksheet").Activate

Workbooks("ITM Report.xlsm").Activate

Dim wbkA As String
Dim wbkB As String

wbkA = Range("B8")
wbkB = Range("B7")

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)


'For each cell in sheet2 that is not the same in Sheet1, color it yellow


'For Each mycell In Workbooks(wbkA).Worksheets("Summary").Range("A" & Rows.Count).End(xlUp).row
For Each mycell In Workbooks(wbkA).Worksheets(1).UsedRange
    'If Not mycell.Value = Workbooks(wbkB).Worksheets("1).Cells(mycell.row, mycell.Column).Value Then
     If Not mycell.Value = Workbooks(wbkB).Worksheets(1).Cells(mycell.row, mycell.Column).Value Then

        mycell.Interior.Color = vbYellow
        mydiffs = mydiffs + 1

    End If
Next

'Display a message box to demonstrate the differences
MsgBox mydiffs & " differences found", vbInformation

'Workbooks(wbkB).Sheets("Summary").Select

End 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

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

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

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

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

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

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

  • ただいまの回答率 88.09%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る