WordにOLEで埋め込んだExcelでWord上に表示させたいセルをVBAで指定するには？

Question

Office2010です。WordにExcelの表がOLEで埋め込んであります。Word上で表示させるセルはExcelで編集し閉じたときに表示されていたセルとなりますよね。つまり、特定のセルを表示させたい場合は、Excelの編集画面でスクロールして左上にそのセルが表示させてExcelを閉じればいいですよね。
これをVBAでやりたいのですが方法が分かりません。教えて戴きますでしょうか。
VBAですが、訳あってExcel-VBAで組んでいます。下の感じです。

Excel-VBAでWord文書を開いて、目的のExcelのOLEオブジェクトを　InlineShapes(n).OLEFormat.Object　で操作しています。最後に　ActiveWindow.ScrollRow　と　ActiveWindow.ScrollColumn　で表示させたいセルを表示させて終わっています。でも、これではダメみたいです。変わりません。
ActiveWindowで表示させてもWordまで渡らないのかな。
どうすればいいか、せめてヒントだけでも。お願いします。

Private EXCEL As EXCEL.Application
Private MSWORD As Word.Application
Private OLE1 As Word.OLEFormat
Private 文書 As Word.Document

    Set MSWORD = CreateObject("Word.Application")
    MSWORD.Visible = True
    Set 文書 = MSWORD.Documents.Open(Filename:=文書ファイルパス) 'Word文書を開く
    Set OLE1 = 文書.InlineShapes(1).OLEFormat
    OLE1.DoVerb VerbIndex:=wdOLEVerbOpen
    
    Set EXCEL = OLE1.Object.Application
    EXCEL.Visible = True
    Set WB = OLE1.Object
    Set WS = WB.Sheets(あるシート名)
   
　　'　・・　あるシート内の操作が続く

    ActiveWindow.ScrollRow = WS.Cells(表示させたい行, "A").Row
    ActiveWindow.ScrollColumn = WS.Cells(表示させたい行, "A").Column

'    WS1 = Cells(表示させたい行, "A").Address
'    Application.Goto Reference:=Range(WS1), Scroll:=True　　これでもダメだった
    
    WB.Close
    Set WS = Nothing
    Set WB = Nothing
    Set EXCEL = Nothing
    Set MSWORD = Nothing

WindFaller · Accepted Answer

新たに見つけた話をここに書いておきます。
>何が違うんだろう。
ここを、もう少し、早く追求すべきでしたね。
たぶん、個々にみると、環境的な違いよりも、ファイルのタイプの違いがありそうな気がします。場合によっては、ExcelとWordをセットにして、ファイルをお渡ししなくてはならないと思います。

だんだん、時間が経つにつれ、逆に、わからなくなってしまいました。

このマクロの前提として、大きな違いが生じる部分が2点あります。

1．Wordは、docx でなくて、doc であることです。この情報は、技術評論社のサイトから見つけたものです。docx(2007以降のものでは動かないそうです。)

2. 埋め込みされたオブジェクトのスタイル(ClassType)によって、挙動が違う可能性があること。（試してみたけれども、自動的に元に戻って、12型=2007になってしまっていましたが、違いは確認されませんでした。)
なお、私の使っているExcelは、2010です。

OLE1.ConvertTo ClassType:=cType
今回試してみたことは、コンバートすることです。

'//
Sub MacroLinkedWord3()
　Dim OLE1 As Word.OLEFormat
　Dim Wb As Excel.Workbook
　Dim xlApp As Excel.Application
　Dim Ws2 As Excel.Worksheet
　Dim MsWord As Word.Application
　Dim objDoc As Word.Document
　Dim cType As String
　
　Const FNAME As String = "C:\Users\[UserName]\My Documents\bb9011694.doc"　'*
　
　On Error Resume Next
　Set MsWord = GetObject(, "Word.Application")
　Set objDoc = MsWord.ActiveDocument
　On Error GoTo 0
　If MsWord Is Nothing Then
　　Set MsWord = CreateObject("Word.Application")
　　Set objDoc = MsWord.Documents.Open(Filename:=FNAME) 'WordojbDocを開く
　End If
　'--------------------------
　MsWord.Visible = True
　Set OLE1 = objDoc.InlineShapes(1).OLEFormat
　'**
　If Not OLE1.ClassType Like "Excel.Sheet.*" Then Exit Sub
　cType = OLE1.ClassType
　OLE1.DoVerb VerbIndex:=wdOLEVerbShow '*NG:wdOLEVerbOpen
　
　'-----------------------------------------
　Set xlApp = OLE1.Object.Parent.Application
　Set Wb = OLE1.Object
　MsWord.Activate
　Set Ws2 = Wb.Worksheets(2)
　xlApp.Goto Wb.Worksheets(2).Cells(13, 1), True
　Wb.Activate
'　Wb.Close True
　OLE1.ConvertTo ClassType:=cType
　'-------------------------------------------
　Set Ws2 = Nothing
　Set Wb = Nothing
　Set xlApp = Nothing
　Set OLE1 = Nothing
　Set MsWord = Nothing
End Sub
'///

kootsuki6 · Answer

WindFallerさん

Excel2007／Word2007で確認しました。
Office2007とOffice2010がターゲットとなります。

結果はやはり同じでした。

OLE1.DoVerb VerbIndex:=wdOLEVerbShow
　でも
　OLE1.Edit
でもダメでした。
コードは以下となります。

Set OLE1 = 文書.InlineShapes(1).OLEFormat
' OLE1.DoVerb VerbIndex:=wdOLEVerbOpen
' OLE1.DoVerb VerbIndex:=wdOLEVerbShow
' OLE1.DoVerb VerbIndex:=wdOLEVerbEdit
OLE1.Edit

Set EXCEL = OLE1.Object.Application
EXCEL.Visible = True
Set WB = OLE1.Object
Set WS = WB.Sheets(件数表シート名)
WDEX表最終行 = WS.Cells(65536, "A").End(xlUp).Row
WS.Range(Cells(WDEX表最終行 - 8, "A"), Cells(WDEX表最終行, "G")).Copy Destination:=WS.Cells(WDEX表最終行 + 4, "A")

件数表シート名は表示されているシートの名前です。
そして、両方共（wdOLEVerbShowとEdit）に最期のcopyメソッドで｢実行時エラー　1004:
'Range'メソッドは失敗しました。'_Worksheet'オブジェクト｣と言うエラーになります。OLE1.DoVerb VerbIndex:=wdOLEVerbOpenの場合はエラーになりません。

WindFallerさんは出来ているとのこと。
何が違うんだろう。

WindFaller · Answer

ご報告：
・WordのInlineShape のオブジェクトには、二種類あって、埋込み型とリンク型があり、今回は、埋め込み型です。
インターネット検索しても、このような、三重(Excel-Word-Excel)の関係で使用している例は、見つかりませんでした。解決しているものは、二重までで限るようです。

・今回の質問自体のマクロの直接の原因は、
　OLE1.DoVerb VerbIndex:=wdOLEVerbOpen　
　これを、
　 OLE1.DoVerb VerbIndex:=wdOLEVerbShow
　にするか、または、
　OLE1.Edit
　にすれば、直ります。

・EXCEL As EXCEL.Application　というオブジェクトは、Excelで起動している限りは、本体と同一のApplication オブジェクトで、オートメーション（仮想で動くExcel)ではないということです。Wordで展開しているExcelは、子(Child)に当たり、起動した本体からは、親の親からでは孫にあたりますので、どしようもない所があるような気がします。

Set xlApp = OLE1.Object.Parent.Application
は、無意味でした。これは、オートメーションによる書き方で、命令方法によっては、自爆命令になり、ハングアップをもたらす原因になりました。
　　　したがって、xlApp.Quitは、不可です。
　　この場合は、
　　WB.Close　は、親(Excel)の親(Word)から子（埋め込み型のExcelシート)は直接の命令ではないので、エラーになります。
　
　・逆に、今までダメだった
　Application.Goto Reference:=Range(WS1), Scroll:=True
でも、可能だということです。
　
　ただ、私自身は、これでは、事実上、解決していません。
　以下をベースにいじってみましたが、Wb.Closeで、問題が発生してしまいます。
　'//
　Sub MacroLinkedWord2()
　Dim OLE1 As Word.OLEFormat
　Dim Wb As Excel.Workbook
　Dim xlApp As Excel.Application
　Dim Ws2 As Excel.Worksheet
　Dim MsWord As Word.Application
　Dim objDoc As Word.Document
　
　Const FNAME As String = "C:\Users\[UserName]\My Documents\bb9011694.doc"
　
　On Error Resume Next
　Set MsWord = GetObject(, "Word.Application")
　Set objDoc = MsWord.ActiveDocument
　On Error GoTo 0
　If MsWord Is Nothing Then
　　Set MsWord = CreateObject("Word.Application")
　　Set objDoc = MsWord.Documents.Open(Filename:=FNAME) 'WordojbDocを開く
　End If
　'--------------------------
　MsWord.Visible = True
　Set OLE1 = objDoc.InlineShapes(1).OLEFormat
　OLE1.DoVerb VerbIndex:=wdOLEVerbShow
　OLE1.Edit '←◎ここ
　''Excelのバージョンは、Wordのバージョンに相応したものです。
　If Not OLE1.ClassType Like "Excel.Sheet.*" Then Exit Sub
　On Error Resume Next
　If OLE1.Object Is Nothing Then
　　MsgBox "OLE オブジェクトが編集できません。", vbExclamation: Exit Sub
　End If
　On Error GoTo 0
　'-----------------------------------------
　Set xlApp = OLE1.Object.Parent.Application
　Set Wb = OLE1.Object
　MsWord.Activate
　Set Ws2 = Wb.Worksheets(2)
　xlApp.Goto Wb.Worksheets(2).Cells(13, 1), True
　'-------------------------------------------
　''Wb.Close 'NG ←問題発生
　Set Ws2 = Nothing
　Set Wb = Nothing
　Set xlApp = Nothing
　Set OLE1 = Nothing
　Set MsWord = Nothing
End Sub
'///

同様の内容が見つかりました。
実際、以下が限界だと思います。コードはスッキリとしています。親(Excel)の親(Word)から子(Excel)という段階には、無理があるのか、技術的な問題のなか、以下のように、Wordからが限界のような気がします。もしくは、Wordを開いた時点で、自動実行させるようなマクロを書いて、二重に稼働させるかというアイデアは残っていますが……。
http://stackoverflow.com/questions/25874167/extract-embeded-excel-workseet-data

WindFaller · Answer

こんばんは。

>私の回避策の方はどうにかなりそうです。
>”アット驚くような解決策”あればいいですね。
期待させた割には、google 検索でも、本当に情報が少なったです。英文で、それらしきことが書いてある所もありましたが、ざっと読んだ限りでは、私の求めているものはダメだと書かれていました。

（ふと思ったのは、埋め込み型で、加工するのは、ちょっと無理があるのかなって思いました。こういう時は、本来、リンクファイルが良いのかなっとさえ思いました。)

それと、Win32 APIで間に合わせようとしても、これまた、動かないというか、Wordの埋め込みオブジェクトに、Excel本体を使っていることがわかり、小窓を使っているのではないことがわかり、Excel→Word→Excelと、ややこしい状態になっていました。

さて、今日の時点では、アットの半分しかありませんでした。気を持たせて悪いのですが、完成品でないと、意味がありませんから、もう一度、まとめてということにさせてください。今、VBAにはよらない方法も考えています。

ただし、ダメだったという報告も含まれている可能性もあります。

明日は、もしかしたら書き込みできるかもしれませんが、その後、用事があって、週末まで間が戻ってこれそうにもありません。それまでは、このスレは開けておいてください。すみません。

WindFaller · Answer

kootsuki4様へ
>誰か革新的な回答をくれるかも知れないので。
Wordというか、この類のソフト(WordStar, WordPerfect－私の使ってきたソフト)は、伝統的？に、いろいろ未知の分野というか、日本人というよりアジア人を見下しているようで、英語が読めない限りは、知らないものが結構あるのです。つまり、端的にいうと、私の経験では、Word VBAは、英語サイトで、アット驚くような解決策が見つかることが多いのです。

>この質問は後数日あけておきたいと思います。
私も探してみますが、私の方も少しだけ時間をください。（返事が出来ないかもしれませんが)

WindFaller · Answer

すみません、私の最初の勘違いから、お手間を取らせ、解決を遅らせてしまいました。私は、ここまで深く掘り下げてやったことはありませんでした。しかし、まだ、私は、基本的な勘違いが存在しているようです。　おそらく、この埋込み型のオブジェクトは、動的な表示が出来ないようなのです。たぶん、オリジナルのWord Document のメモリ枠が静的な状態だからではないでしょうか。　だから、Goto でも、Selectでも、表示そのものは移動して、画面が切り替わらないと考えました。（私の推論です。この先、誰かが、否定する可能性はありますし、この件は、Microsoft が、この問題について解答している可能性もあります。Wordの未完成の部分で、それを補うメソッドがあったことがあります。)　現状で私が取りうる範囲としては、同じ型、同じ大きさという条件を考えると、コピーして表示ならできるわけです。) 　こういう策を考えてみました。簡単な話なのですが、予め、シートを増やしておきます。 Dim OLE1 As Word.OLEFormat Dim Wb As Excel.Workbook Dim xlApp As Excel.Application Dim Ws1 As Excel.Worksheet Dim Ws2 As Excel.Worksheet Dim Ws3 As Excel.Worksheet　　'←新たに設けました。 '---略--- '-------------------------- MsWord.Visible = True Set OLE1 = objDoc.InlineShapes(1).OLEFormat If OLE1.ClassType <> "Excel.Sheet.12" Then Exit Sub On Error Resume Next '一応、埋込み型がActivate できない時のために加えます。 If OLE1.Object Is Nothing Then 　MsgBox "OLE オブジェクトが編集できません。", vbExclamation: Exit Sub End If 　OLE1.DoVerb Verbindex:=wdOLEVerbOpen On Error GoTo 0 Set xlApp = OLE1.Object.Parent.Application Set Wb = xlApp.ActiveWorkbook '　　'　・・　あるシート内の操作が続く Set Ws1 = Wb.Worksheets("Sheet1") Set Ws2 = Wb.Worksheets("Sheet2") Set Ws3 = Wb.Worksheets("Sheet3")　　'ダミーの表示用として加えました。 OLE1.Edit　'不要かもしれませんが、入れました。 Ws3.Activate If Ws3.Cells(1, 1).Value <> "" Then 　 Ws3.Range("A1:B7").ClearContents　'不要の範囲を削除 End If Set rng = Ws2.Range("A13:B20")　'表示するための範囲を設定 rng.Copy Ws3.Cells(1, 1)　'シート3にコピーして表示 Wb.Close objDoc.Activate Set Ws = Nothing Set Wb = Nothing Set OLE1 = Nothing Set MsWord = Nothing Set xlApp = Nothing End Sub

WindFaller · Answer

追伸：画像添付を忘れてしまいました。（^^;
なお、画面キャプチャーは、FastStone Capture (本来は、これだけで十分)、新たに、LibreOffice Draw をレイアウトに使いました。

WindFaller · Answer

>画像を用意したのですが、教えてGooは画像は添付できないようです。
昔と違い、追画像添付が可能のはずです。私は、回答者オンリーですから、その仕組みは分かりませんが。

すぐに返事できなくて、申し訳ありませんでした。#2の返事の内容をみると、同じように作っていると思ったけれども、私は、根本的な勘違いしていた部分がありました。それに気がつかないとは、本当に、とほほです。

これは、実際のマクロ－－雑な書き方をしていますが、たぶん、私の考えていることは分かっていただけるはずです。 GetObject(, "Word.Application")　の辺りは、当該WordのDocumentを開いている時です。単に、問題なのは以下の1行だけで、後は、わたし流の書き方だというだけで、無視してよいです。

[Ws.Parent.Application.Goto Reference:=Wb.Worksheets("Sheet2").Cells(1, 1), Scroll:=True ]
親[Parent]から実行しました。

これで「切り替わり」が、うまくいきました。

なお、今回添付の画像は、新しいソフト(LibreOffice Draw)を使って作ってみました。

変数の省いている部分は、Object でも、各名称でも良いです。

'//
Sub MacroLikedWord()
Dim Wb
Dim Ws
Dim objExcel
Dim MsWord As Word.Application
Dim objDoc As Word.Document
Dim OLE1 As Word.OLEFormat

Const FNAME As String = "C:\Users\[MyName]\My Documents\bb9011694.docx"

On Error Resume Next
　Set MsWord = GetObject(, "Word.Application")
　Set objDoc = MsWord.ActiveDocument
On Error GoTo 0
If MsWord Is Nothing Then
　Set MsWord = CreateObject("Word.Application")
　Set objDoc = MsWord.Documents.Open(Filename:=FNAME) 'WordojbDocを開く
End If
MsWord.Visible = True
Set OLE1 = objDoc.InlineShapes(1).OLEFormat
OLE1.DoVerb VerbIndex:=wdOLEVerbOpen
Set Wb = OLE1.Object
Set Ws = Wb.Worksheets("Sheet2")

'　　'　・・　あるシート内の操作が続く

Ws.Parent.Application.Goto Reference:=Wb.Worksheets("Sheet2").Cells(1, 1), Scroll:=True 'ここ

'ActiveWindow.ScrollRow = Ws.Cells(表示させたい行, "A").Row
'ActiveWindow.ScrollColumn = Ws.Cells(表示させたい行, "A").Column
'
'' WS1 = Cells(表示させたい行, "A").Address

''
Wb.Close
Set Ws = Nothing
Set Wb = Nothing
Set OLE1 = Nothing
Set MsWord = Nothing　　'登録した順序の逆をする
End Sub
'///

WindFaller · Answer

こんにちは。

>Wordの中のExcelオブジェクトではなく、

条件がぜんぜん違っていたようです。話が後先になってしまうのですが、もう一度確認させてください。

私は、ExcelからWordを起動し、コントロールするものだと思っていました。ただし、Word側のリンクしているExcelとは別です。

（私の試した方法)
+Word (オートメーション－OLE)
|　　|リンク－埋め込み型
|　　Excel -- ファイル xlsx　（マクロは搭載しない)
|　
+　Excel--Word をコントロールするファイル xlsm (VBAマクロ搭載)

という条件でやっていました。

リンクしているExcelは、マクロ搭載しないかというと、セキュリティに引っかかってしまうからですが、それでも、やっぱりセキュリティに引っかかってしまい、リンクは閉じてしまう、というのが、現在の状況です。以前は、こんなことはなかったはずですが、何かが変わったのかもしれません。

これが、はっきりしてから、次の検証に入ります。しばし、猶予をお願います。

WindFaller · Answer

なかなか、ややこしいことをしているような気がしますね。
一応、今回は、特例で、このコード全体は再現できていないので、不具合がある時は、再度、ご指摘ください。

最初の起動の所で通っていますか？それは問題なく通っているなら、問題ないのですが。
（起動の部分で、実際のこちらのPCでは、オブジェクトにアクセスしようとすると、ロックが掛かってしまうのか、再現できません。)

その上で、お答えしているので、詰めが甘いのはご容赦ください。

Application.Goto Reference:=Range(WS1), Scroll:=True
そうではなくて、

>Set WS = WB.Sheets(あるシート名)
　　　
Set WS = WB.Worksheets(あるシート名)　'←特別な意味はない。

そして、WS の配下のApplicationを使えばよいのではありませんか？
WS.Application.Goto Reference:=Worksheets(任意).Cells(任意の行,任意の列), Scroll:=True

ただし、このコードでは、WB.Close　は、動かないような気がします。

WordにOLEで埋め込んだExcelでWord上に表示させたいセルをVBAで指定するには？

新たに見つけた話をここに書いておきます。

WindFallerさん

ご報告：

こんばんは。

kootsuki4様へ

すみません、私の最初の勘違いから、お手間を取らせ、解決を遅らせてしまいました。

追伸：画像添付を忘れてしまいました。

>画像を用意したのですが、教えてGooは画像は添付できないようです。

こんにちは。

なかなか、ややこしいことをしているような気がしますね。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング