[[20250402114157]] 『ExcelVBAでWordファイルの操作がしたい。』(Ken_Matu) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) |

| 全文検索 | 過去ログ ]

 

『ExcelVBAでWordファイルの操作がしたい。』(Ken_Matu)

今日は、初めて質問します。

ExcelVBAでWordファイルの操作がしたいのですが、下記コードのように既存のWordファイルを起動してActiveにするコードはネットを探せばいくらでも見つかるのですがどういうわけか初めから起動するのではなくてすでに起動しているWordファイルをActiveにするコードが見つかりません。どなたかご教授くださいませんか?よろしくお願いします。

既存のWordファイルを起動してActiveにする
Sub ワード転記()
 Dim WordApp As Object
 Dim WordDoc As Word.Document
 Set WordApp = CreateObject("Word.Application")
 WordApp.Visible = True 'Wordを起動する
 Set WordDoc = WordApp.Documents.Open("C:\Users\・・\ファイル名.docx") '選択したWordファイルを起動します。

 WordApp.Activate
 WordDoc.Activate

 Set WordDoc = Nothing
 Set WordApp = Nothing

End Sub

この「WordApp.Documents.Open」というコードを開いているファイルにActiveできるようなコードに変えればいいのですが、ちょっとやり方がわかりません。

どなたかご教授をお願いします。

< 使用 Excel:Microsoft365、使用 OS:Windows11 >


GetObject

かな

(*^^*)。。。違っていましたらお許しを << _ _ >>
(隠居Z) 2025/04/02(水) 13:56:10


なるほど
「Set WordApp = CreateObject("Word.Application")」を
「Set WordApp = GetObject("Word.Application")」に変更すればよろしいんですね。
でもその後がわかりません。

(Ken_Matu) 2025/04/02(水) 14:13:56


 AppActivate ステートメントを調べて下さい。

(xyz) 2025/04/02(水) 14:31:23


え〜と何のためのコードか目的が解りませんので
サンプルです。。。
GetObject
は奥が深く様々な使い方が出来ると私は思っております。別に起動されいなくとも開く事が
出来ます。気を付けないと処理後に非表示になりロック状態になることも有るみたいですし
よくヘルプ、及び参考サイト、書物等でご理解を得たうえでのご使用を推奨いたします。^^;

 ↓ シート名 Sheet1 のA1セルは初期化されます。

 Option Explicit
Sub OneInstanceMain()
    Dim i As Long
    Dim wd, dc1, docx, eflg, tmp
    dc1 = ThisWorkbook.Path & "\ExcelTest.docx"
    tmp = Split(dc1, "\")
    On Error GoTo errstp
    Set wd = GetObject(, "Word.Application")
    wd.Visible = True
    For i = 1 To wd.documents.Count
    Debug.Print wd.documents(i).Name
        If wd.documents(i).Name Like tmp(UBound(tmp)) Then
            eflg = True
            Exit For
        End If
    Next
    If eflg Then
        Set docx = wd.documents(i)
    Else
        Set docx = wd.documents.Open(dc1)
    End If
    With Worksheets("Sheet1").Cells(1)
        .Value = ""
        .Value = docx.Name
    End With
    wd.Activate
    Stop
    docx.Close
    Rem wd.Quit
    Exit Sub
errstp:
    If Err.Number = 429 Then
        MsgBox "wordは起動されておりません" & Chr(13) & Err.Description
    End If
End Sub
でわでわ、お後がよろしい様で
m(__)m
(隠居Z) 2025/04/02(水) 16:45:09

 下記のヘルプの例に載っているのですが、うまくいかないですね。
 https://learn.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/appactivate-statement
 私のは没でお願いします。失礼しました。
(xyz) 2025/04/02(水) 20:31:52

 こんな感じで動作しました。
 Sub ワードDocを前面に出してActiveに()
     ' Microsoft Word 16.0 Object library を参照設定済み
     Const s$ = "D:\MyDocuments\202504\20250402_01 test.docx" '既に開いているWordファイルのpathname
     Dim WordDoc  As Word.Document
     Dim myCaption$

     Set WordDoc = GetObject(s)
     myCaption = Dir(s) & " - Word"
     AppActivate myCaption
     Set WordDoc = Nothing
 End Sub
(xyz) 2025/04/02(水) 22:38:32

 myCaption = Dir(s)
 でも問題ないようです。
(xyz) 2025/04/02(水) 22:51:03

貴重な情報をありがとう御座います。大変勉強になりましたです。(*^^*)//////
開いているドキュメントの名前にすれば良かったのですね。
m(__)m
(隠居Z) 2025/04/02(水) 22:58:38

 隠居Zさんコメントありがとうございました。
 例示が AppActivate "Microsoft Word"とあったので、最初はそれを試していました。
 Captionがアプリケーション名だけだった時代の名残なんでしょうか。今どきのものに合わせて欲しいですよね。
 ファイル名 - Word でも動作してしまう理由も分かりませんが、
 ファイル名 - Word2 とか
 ファイル名 - Microsoft Word とかだとエラーになるので、
 二つのケースに限定してOKとしている印象です。
(xyz) 2025/04/03(木) 09:21:22

 削除しました。
(んなっと) 2025/04/03(木) 11:38:44

 なるほど、 " - Word" をつけないとだめなんですね
 Sub sample()
    Set wdApp = GetObject(, "Word.Application")
    AppActivate wdApp.Windows(1).Caption & " - Word"
 End Sub
(´・ω・`) 2025/04/03(木) 13:02:07

Set WdApp = GetObject(, "Word.Application")
CreateObject("WScript.Shell").AppActivate WdApp.Caption

???
(まじめな人) 2025/04/03(木) 13:43:24


 (´・ω・`)さんの式でうまくいきますね。
私のは表示モードに依存するので、なしで。
(んなっと) 2025/04/03(木) 14:42:53

隠居Zさん
ありがとうございました。
>え〜と何のためのコードか目的が解りませんので
サンプルです。。。

目的はですね、2つのExcelブックから表やテキストを一斉に既存のWordに転記作業を行いたいのですが。
まず一つ目のExcelブックから転記するときに既存のWordを起動してから転記作業を行って次のExcelブックから転記作業を行う時は当然既存のWordは起動されているわけですからそのWordをアクティブにするコードが必要だったのです。

私は勤務しており、隠居Zさんのご教授頂いたコードを理解するのに時間がかかりますので後でまたお問い合わせしますので、よろしくお願いします。
(Ken_Matu) 2025/04/03(木) 16:28:24


横からですが「Wordに転記作業を行いたい」というところだけみると、オブジェクトとして掴んでいるならば別にActiveにする必要はないとおもいますけど認識違いでしょうか?

(もこな2) 2025/04/04(金) 08:02:34


もこな2さん
どうなんですかね。

Excelのワークブック同士でコピペ作業を繰り返すときに

Sub 転記()
  Dim wb, wbP As Workbook 

    Set wb = ActiveWorkbook ’今開いているワークブック
    Set wbP = Workbooks("ファイル名.xlsm") ’貼り付け先のワークブック
  
  wb.Activate
    Sheets("シート名1").Select
    コピー処理

  wbP.Activate

    Sheets("シート名2").Activate
  貼り付け処理

  wb.Activate

    Sheets("シート名3").Select
    コピー処理

  wbP.Activate

    Sheets("シート名4").Activate
  貼り付け処理

End Sub

のようにワークブック同士でコピペを繰り返すときにいったんコピー元のオブジェクトを離して貼り付け先のオブジェクトで貼り付け処理をしてまたコピー元のオブジェクトに戻るときはActivateが必要になりますね。Wordへの転記もこれと同じようなイメージです。

  
(Ken_Matu) 2025/04/04(金) 14:56:10


 もこな2さんのコメントは、
 Worksheets("Sheet1").Range("A1:B2").Copy Worksheets("Sheet2").Range("A1")
 と書けば、逐一シートをアクティブにする必要はない、といったことです。
 (シートやセルを逐一Selectしない、という点を理解することは初級から脱却する目安、などと
 言われることがあるようです。)

 WordDocオブジェクトを得ることができれば、基本的にはActiveにする必要はない、というのは
 正しい指摘でしょう。
 個人的には、GetObjectや、AppActivateなどを再確認できてよかったですけど。

(xyz) 2025/04/04(金) 15:14:16


同じワークブック内でコピペを繰り返すのではなくてコピー元のワークブックでコピー処理を行ってから貼り付け先のワークブックへ飛んで貼り付け処理を行ってからまた同じコピー元のワークブックへ戻るといった流れになるのですが・・。
(Ken_Matu) 2025/04/04(金) 15:23:50

 同じことです。
(xyz) 2025/04/04(金) 15:30:29

worksheetsオブジェクトの前に、workbooksオブジェクトを指定するだけですよ
こういうのはコードを書いて試すのが一目瞭然だと思います
(ROM) 2025/04/04(金) 15:36:44

そうなんですか?それは知りませんでした。わざわざ変数でセットしなくてもよいということですか?
試してみます。

それから会社のPCから投稿してますが、システム障害が起きているようで、こちらへの投稿は一旦お休みにしますね。色々とありがとうございました。
(Ken_Matu) 2025/04/04(金) 16:45:29


変数にセットする云々については何も申し上げていません。
アクティブにするとか選択する必要はないと申し上げました。

いずれ作業を終わった後の確認のためにアクティブにすることはありますし、
Wordをアクティブにすること自体に反対しているわけではありません。
ただし、それが必須かというとそうではないし、多数の転記をする際に、
選択という動作は速度上不利になります。
またコードの可読性を高める効果もあります。そういうことです。 
(xyz) 2025/04/04(金) 17:02:16


(Ken_Matu) 2025/04/04(金) 14:56:10 のコードを書き換えるなら、
たとえば以下の様にも書けるということです。
(セルのアドレスは適当に決めました)

 Sub 転記()
    Dim wb As Workbook, wbP As Workbook

    Set wb = ActiveWorkbook
    Set wbP = Workbooks("ファイル名.xlsm")

    wb.Sheets("シート名1").Range("A1").Copy Destination:=wbP.Sheets("シート名2").Range("A1")
    wb.Sheets("シート名3").Range("B1").Copy Destination:=wbP.Sheets("シート名4").Range("B1")
 End Sub

効果・利点については、既に述べられている通りです。
(ROM) 2025/04/04(金) 17:46:26


 既に開いているWordに転記するという方法は取り合えず横においておいて、
 まずは、新規にWordを開いて転記するという方法で、目的を達成することに
 注力されたほうがよいと思います。それで特段支障があるとも思えません。

 "excel vba word 転記"などでNet検索すれば色々有用な記事があります。
 まずは、それに習熟するほうが先決だと思います。
 そこでExcel、Wordをその都度アクティブにしているか確認するとよいでしょう。 
 単にコピーペイストする訳に行きませんし、Wordドキュメントの扱いに関しては、
 それはそれでExcelと違う点がありますから。そちらのほうにまず習熟されたらいかがですか?
 特段のことがなければ私はこれで失礼します。

 なお、参考となるコードを提示いただいた´・ω・`さん、隠居Zさんはじめ、皆さんありがとうございました。
 勉強になりました。

(xyz) 2025/04/04(金) 19:12:58


xyzさん お気遣いありがとうございました。こちらこそ何時も勉強させて戴いております
     感謝感謝です。

暇でしたので。作り直して見ました。
私としてはエクセルだけで完了出来るのではとか思いますがWORD VBA も
お勉強しようかな。。。とかおもっていましたので。← そのわりに中途半端なコードと
なっており汗顔の至りです。^^; (肝心のワード書込みプロシジャは超簡略(*^^*))

 Option Explicit
Public Declare PtrSafe Function FindWindow _
Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
                                  ByVal lpWindowName As String) As Long
Declare PtrSafe Function IsWindowVisible _
Lib "user32" (ByVal hWnd As Long) As Long
Declare PtrSafe Function GetClassName _
Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, _
                                    ByVal lpClassName As String, _
                                    ByVal nMaxCount As Long) As Long
Declare PtrSafe Function GetNextWindow _
Lib "user32" Alias "GetWindow" (ByVal hWnd As Long, _
                               ByVal wFlag As Long) As Long
Rem ---- GetNextWindow
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2
Sub OneInstanceMain()
    Dim wD            As Object
    Dim dCx           As Object
    Dim eFlg          As Boolean
    eFlg = GetMsWordBoot
    MyMsWordDocumentGet wD, dCx, eFlg
    wDdocWrite dCx
    dCx.Close True
    If Not eFlg Then wD.Quit
    Set wD = Nothing
    Set dCx = Nothing
End Sub
Private Sub wDdocWrite(dCx)
    With dCx
        .Content.InsertAfter "EXCEL" & Space(1)
    End With
End Sub
Private Sub MyMsWordDocumentGet(wD, dCx, ByVal eFlg As Boolean)
    Dim vAr           As Variant
    Dim dCnm          As String
    Dim dCFlg         As Boolean
    Dim fs            As Object
    dCnm = ThisWorkbook.Path & "\" & "ExcelTest.docx"
    If eFlg Then
        Set wD = GetObject(, "Word.Application")
    Else
        Set wD = GetObject("", "Word.Application")
    End If
    wD.Visible = True
    For Each vAr In wD.Documents
        If vAr.Name = dCnm Then
            dCFlg = True
            Exit For
        End If
    Next
    If dCFlg Then
        Set dCx = vAr
    Else
        Set fs = CreateObject("Scripting.FileSystemObject")
        If fs.FileExists(dCnm) Then
            Set dCx = wD.Documents.Open(dCnm)
        Else
            Set dCx = wD.Documents.Add()
            dCx.SaveAs2 dCnm
        End If
    End If
End Sub
Private Function GetMsWordBoot() As Boolean
    Dim i             As Long
    Dim ClassNameTx   As String * 100
    Dim hWnd          As Long
    GetMsWordBoot = False
    hWnd = FindWindow(vbNullString, vbNullString)
    Do
        If IsWindowVisible(hWnd) Then
            GetClassName hWnd, ClassNameTx, Len(ClassNameTx)
            ClassNameTx = Trim(Replace(ClassNameTx, vbNullString, ""))
            If ClassNameTx Like "*OpusApp*" Then
                GetMsWordBoot = True
                Exit Do
            End If
        End If
        hWnd = GetNextWindow(hWnd, GW_HWNDNEXT)
        i = i + 1
        If i Mod 32 = 0 Then DoEvents
        If hWnd = GetNextWindow(hWnd, GW_HWNDLAST) Then Exit Do
    Loop
End Function

誰かが当該のファイルを編集中。。。他諸々等々の例外処理は
何もしてませんです。
おあとがよろしいようで
<< _ _ >>
(隠居Z) 2025/04/06(日) 16:54:52


既に指摘があるところですが、「ワークブック同士で〜」の部分に認識違いがあります。
pasteメソッドを使おうとするなら、確かに該当シートをアクティブにする必要があります。

ただ(既に説明されているように)、copyメソッドの引数で貼付先を指定するとか、pastespacialを使うなどの方法で対象のシートをアクティブにしなくても貼付できます。

私自身WordVBAに詳しくないですし、掲示板の趣旨から逸れるので深掘りしませんが、「WordDoc」にオブジェクトとしてつかんでいるのだから、貼付位置が決まっているならアクティブにする必要ないのでは?という疑問でした。

いや、カーソル位置に貼り付けたいのでアクティブにする必要があるのだ等、事情があるのであれば、余計なコメント失礼しました。

(もこな2 ) 2025/04/07(月) 08:52:10


 pasteメソッドも、activesheetに限定されない

 Sub test()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet

    Set ws1 = Workbooks("Book1").Worksheets(1)
    Set ws2 = Workbooks("Book2").Worksheets(1)
    Set ws3 = Workbooks("Book2").Worksheets(2)

    ws1.Range("A1:A2").Copy
    ws2.Paste Destination:=ws2.Range("C3")
    ws1.Range("A3").Copy
    ws3.Paste Destination:=ws3.Range("C3")
      
 End Sub
(マナ) 2025/04/07(月) 10:55:03

>pasteメソッドも、activesheetに限定されない

フォローありがとうございます。
(なんかのときにアクティブシートじゃなきゃダメだった気がしましたが記憶違いだったようです。)

(もこな2 ) 2025/04/07(月) 12:22:53


 局面によっては選択が必要になるという話ですね。
 閲覧されているかたの参考のためにメモしておきます。

 Worksheet.Pasteのヘルプによると
 > Destination 引数を指定しない場合は、このメソッドを使用する前に宛先範囲を選択する必要があります。
 セルを選択するには、シートを選択しないといけない。
 つまり、こんな風に書かないといけない、ということですね。
 Sub test()
     Sheet1.[A1].Copy
     Sheet2.Select
     [A1].Select
     Sheet2.Paste
 End Sub

 しかし、PasteにDestination 引数を使えば、シートもセルも選択は必要ないということです。
 さらに言えば、Copyに続けて、Destination引数を使えば一行で済むということです。

 # 私も長いことPasteは使うことがなかったので、つい数年前まで気づいていなかったですね。

(xyz) 2025/04/07(月) 14:24:24


こんにちわ ^^
もうご覧になっておられないかもしれませんが。Word VBA いじってみましたが^^;
も〜たいへん。。。同じVBAでも似て完全に違うものなのだぁ〜。。。←。。。が感想です
おなじ予約語がたくさんありますけど似たものも有りますがほとんど別物の様です
新たに違うプログラム言語習得と同じようなレベルだと感じました。
エクセルオンリーの方が私は絶対楽かもしれませんどうしてもWORDを使うなら、一つの
図形にまとめ、図形一枚と2〜3行文字挿入で完了!みたいな感じにすると思います。

余計なお世話でしたら無視して下さいませ。Excel VBAだけで。というお話でしたら
何かお手伝いくらいは出来るかもしれません。それ以外でしたら私はこれにて失礼致します。
でわ、頑張ってくださいね。m(__)m

(隠居Z) 2025/04/08(火) 07:48:54


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.