『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 >
かな
(*^^*)。。。違っていましたらお許しを << _ _ >>
(隠居Z) 2025/04/02(水) 13:56:10
(Ken_Matu) 2025/04/02(水) 14:13:56
AppActivate ステートメントを調べて下さい。
(xyz) 2025/04/02(水) 14:31:23
↓ シート名 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
隠居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
???
(まじめな人) 2025/04/03(木) 13:43:24
(´・ω・`)さんの式でうまくいきますね。 私のは表示モードに依存するので、なしで。 (んなっと) 2025/04/03(木) 14:42:53
目的はですね、2つのExcelブックから表やテキストを一斉に既存のWordに転記作業を行いたいのですが。
まず一つ目のExcelブックから転記するときに既存のWordを起動してから転記作業を行って次のExcelブックから転記作業を行う時は当然既存のWordは起動されているわけですからそのWordをアクティブにするコードが必要だったのです。
私は勤務しており、隠居Zさんのご教授頂いたコードを理解するのに時間がかかりますので後でまたお問い合わせしますので、よろしくお願いします。
(Ken_Matu) 2025/04/03(木) 16:28:24
(もこな2) 2025/04/04(金) 08:02:34
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
同じことです。 (xyz) 2025/04/04(金) 15:30:29
それから会社のPCから投稿してますが、システム障害が起きているようで、こちらへの投稿は一旦お休みにしますね。色々とありがとうございました。
(Ken_Matu) 2025/04/04(金) 16:45:29
いずれ作業を終わった後の確認のためにアクティブにすることはありますし、
Wordをアクティブにすること自体に反対しているわけではありません。
ただし、それが必須かというとそうではないし、多数の転記をする際に、
選択という動作は速度上不利になります。
またコードの可読性を高める効果もあります。そういうことです。
(xyz) 2025/04/04(金) 17:02:16
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
暇でしたので。作り直して見ました。
私としてはエクセルだけで完了出来るのではとか思いますが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
ただ(既に説明されているように)、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
フォローありがとうございます。
(なんかのときにアクティブシートじゃなきゃダメだった気がしましたが記憶違いだったようです。)
(もこな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
余計なお世話でしたら無視して下さいませ。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.