常連

### 前提
word 2021

目次を作成したwordファイル表示時に自動的にナビゲーションを表示して
PDFのしおりのように使用したいと思い、マクロでナビゲーションの自動表示を設定しました。
しかし、マクロを設定したファイルのみナビゲーションを表示したいのですが、
一旦マクロの設定があるファイルを開いてナビゲーションが表示されると、
他のwordファイル(マクロ設定なし)を開いた時にもナビゲーションが表示されてしまいます。

### 実現したいこと

あくまでもマクロの範囲はマクロ設定ファイルのみにしておきたいのですが、
何か方法はありますでしょうか？

### 該当のソースコード

```vba
Private Sub Document_Open()
   ThisDocument.ActiveWindow.DocumentMap = True
End Sub
Private Sub Document_Close()
    ThisDocument.ActiveWindow.DocumentMap = False
End Sub
```

### 試したこと
Document_Open()の部分でナビゲーションは表示されるので
同じくDocument_Close()でFalseを設定すればナビゲーションが非表示になって終わればいいなと思ったんですが駄目でした。
Project配下のThisDocumentファイルに記述しています。

何か方法はありますでしょうか？



Wordのマクロでマクロ設定ファイルのみナビゲーションウィンドウを表示したい

### 質問
現在プログラミングを学び中です。
WordとExcelの変換アプリを作りたいのですが下記のコードだとWordの語句変換のみ置換成功のメッセージは出るものの、Wordファイルを確認すると置換されていません。Excelの方は問題なしです。
ライブラリがインストールされているか、デモプログラムを確認したりしましたが原因が分からず困っています。
解決策をご教授ください。### ヘディングのテキスト
宜しくお願い致します。



### 該当のソースコード

```Python
import glob
import os
import openpyxl
import time
import PySimpleGUI as sg
import docx
  
# 対象ファイル種別
fileType = ['*.xlsx']         # openpyxlは、[*.xls]拡張子に非対応
fileType_docx = ['*.docx']    # docxファイルのみ対応

# logic 置換処理
def exe_strchange(File_path_str, Before_str, After_str):
    
    start = time.perf_counter() # 実行時間計測開始

    #「対象フォルダのパス」配下にあるExcelファイルのパスを出力
    list_path_file = []
    for ext in fileType:
        # サブフォルダまで検索可能
        list_path_file.extend(glob.glob(os.path.join(File_path_str + r'/**/',ext), recursive=True)) 

    #「対象フォルダのパス」配下にあるWordファイルのパスを出力
    list_path_file_docx = []
    for ext in fileType_docx:
        # サブフォルダまで検索可能
        list_path_file_docx.extend(glob.glob(os.path.join(File_path_str + r'/**/',ext), recursive=True)) 

    print('◆検索対象ファイル数:' + str(len(list_path_file)))

    # 各ファイル数カウント
    total_count = 0    #変換総数
    book_count = 0     #Excel変換数
    doc_count = 0      #Word変換数

    # ------------------
    # Excelファイル数分ループ
    # ------------------
    for book in list_path_file:
        print("■対象ファイル: " + book)
        bookFlg=0
        #ブックの取得
        #openpyxl.load_workbook('Excelファイルのパス')
        actBook = openpyxl.load_workbook(book)
        
        #シート数分ループ
        for actSheetName in actBook.sheetnames:
            print("■対象シート"+ actSheetName)
            count = 0

            #アクティブシートを取得 #ブック変数[シート名]
            actSheet = actBook[actSheetName]

            #　userdrange範囲内のセルに対して文字列の一致したセルを置換する
            for row in actSheet.iter_rows(min_row=actSheet.min_row,max_row=actSheet.max_row,min_col=actSheet.min_column,max_col=actSheet.max_column):
                # if any(is_empty(c) for c in row):
                #     continue
                for cell in row:
                    if str(cell.value) in Before_str:
                        cell.value = After_str
                        count+=1
                        bookFlg=1
            
            print(str(count) + "件置換しました。")
            
        #ブックを保存
        if bookFlg == 1:
            total_count+=1
            book_count+=1
            #ブック変数.save(Excelファイルのパス)
            actBook.save(book)
            # elapsed_time_file = time.perf_counter() - start
            # print("1ファイル処理時間(elapsed_time):{0}".format(elapsed_time_file) + "[sec]")
                
        else:
            actBook.close

    # ------------------
    # wordファイル数分ループ
    # ------------------
    for document in list_path_file_docx:
        print("■対象ファイル: " + document)
        doxcFlg=0
        #docxの取得
        #openpyxl.load_workbook('ファイルのパス')
        actdoc = docx.Document(document)
        count = 0
        #　userdrange範囲内のセルに対して文字列の一致したセルを置換する
        for para in actdoc.paragraphs:
            # if any(is_empty(c) for c in row):
            #     continue
            
            if para.text in Before_str:
                para.text.replace(Before_str, After_str)
                count+=1
                doxcFlg=1
        
        print(str(count) + "件置換しました。")
            
        #ファイルを保存
        if doxcFlg == 1:
            total_count+=1
            doc_count+=1
            #保存: docx変数.save(ファイルのパス)
            actdoc.save(document)

        else:
            actdoc.close

    # 経過時間
    elapsed_time = time.perf_counter() - start

    result_str_list = [
        '検索対象Excelファイル数:' + str(len(list_path_file)), '変換Excelファイル数:' + str(book_count),
        '検索対象Wordファイル数:' + str(len(list_path_file_docx)), '変換Wordファイル数:' + str(doc_count),
        '変換ファイル総数:' + str(total_count),'Total処理時間:{0}'.format(elapsed_time) + '[sec]']

    return result_str_list


def main():
    sg.theme('Blue Mono')
    layout = [[sg.Text('指定フォルダ内のサブフォルダ対応')],
            [sg.Text('FolderPath:'), sg.Input(size=(56,1), key='-IN_File-')],
            [sg.Text('置換前(検索値):'), sg.Input(size=(50,1), key='-IN_Before-')],
            [sg.Text('置換後(変換値):'), sg.Input(size=(50,1), key='-IN_After-')],
            [sg.Button('実行', bind_return_key=True)]
            ]

    window = sg.Window('Excel&word 文字列置換ツール', layout) #GUIウィンドウ設定

    event, values = window.read(close=True)
    if event == sg.WIN_CLOSED:
        window.close()
    if event == '実行':
        # 画面テキスト入力内容取得
        File_path_str = values['-IN_File-']
        Before_str = str(values['-IN_Before-'])
        After_str = str(values['-IN_After-'])
        
        # logic関数実行
        result_str =exe_strchange(File_path_str, Before_str, After_str)
        
        # 結果表示
        sg.popup_scrolled('完了!\n' + result_str[0] + '\n' + result_str[1] + '\n' + result_str[2] + '\n' + result_str[4] + '\n' + result_str[5])
    
    window.close()

if __name__ == '__main__':
    main()





[Python・PysimpleGUI] Wordの語句置換がうまくいかない

### 前提・実現したいこと

Excel、Wordでハイパーリンクを使用してリンクを張っていましたが、
絶対パスではなく、相対パスでのリンクを張って欲しいと上司に頼まれました。
Excelでは簡単に修正できましたが、Wordではどうしたら相対パスにできますでしょうか。


### 補足情報（FW/ツールのバージョンなど）

Microsoft　Word 2016

Wordでのハイパーリンクを絶対パスから、相対パスに変更したい

プロキシのあるLANでMicrosoft Officeを利用すると、あまりにも頻繁に「office15client.microsoft.comのプロキシサーバーに接続しています」というダイアログが立ち上がります。もうこれが邪魔で鬱陶しくてほとほと困っておりまして、これを出さない方法があれば、ご教授願います。

######環境
- Windows 8.1 Pro
- Microsoft Office 2013
######条件
- プロキシやLANは、私には勝手に設定できません。
- 「officeのインターネット接続を許可する」からチェックを外していますが、依然として解決しません。
- プロキシの無いLANでも使用するため、プロキシの設定は特にせず、LANの設定は自動的に検出するようにしています。

しつこいダイアログ「office15client.microsoft.comのプロキシサーバーに接続しています」を出さないためには

### 前提・実現したいこと
VBAを使いExcelのB1～B4にある、会場、顧客名、ID、パスワードの情報を基に
テンプレートのWordをコピーし、中身の表に情報を入力していくようなコードを作成したいと考えております。（コードはExcelの方で書いています）
1回目は成功しても、2回目にエラー462が発生します。
一度、終了し該当ファイルを削除後に再実行すると成功します。
たて続けに実行するとエラーが発生するようです。

Microsoftのヘルプページを見てみると、「2 回目のコード実行時に Excel のオートメーションが失敗する」に該当するようで、解決方法「この問題を解決するには、適切なオブジェクト変数で修飾して、Excel のオブジェクト、メソッド、またはプロパティをそれぞれ呼び出すようにコードを変更します。」とありますがどうすれば分かりませんでした。

解決方法をご教示頂けますでしょうか。


### 発生している問題・エラーメッセージ

```
実行エラー 462
リモートサーバーがないか、使用できる状態ではありません。
```

### 該当のソースコード

```VBA

Sub make()

Dim i As String
Dim name As String
Dim B1 As String
Dim site As String
Dim Ex As Excel.Application
Set Ex = CreateObject("Excel.Application")

B1 = Sheets("Input").Range("B1").Value       ←大阪会場、東京会場の区別をしています。
If B1 = "大阪" Then
site = "大阪"
Else
site = "東京"
End If

i = Sheets("Input").Range("B2")

Dim target As String
target = "C:\Users\Desktop\セールのご案内(" & i & "様)(" & site & "会場).doc"

If Dir(target) <> "" Then　　　　←もし、同じ名前のWordがある場合は、メッセージを表示し終了
MsgBox "既に作成されています。フォルダ内を確認してください。"
GoTo byebye
Else
 
FileCopy "C:\Users\Desktop\テンプレート\セールのご案内(お客様名)(" & site & "会場).doc", "C:\Users\Desktop\セールのご案内(" & i & "様)(" & site & "会場).doc"

Sheets("Input").Range("C1") = "C:\Users\Desktop\セールのご案内(" & i & "様)(" & site & "会場).doc"

Dim Document As Word.Application
Set Document = CreateObject("Word.Application")
Document.Application.Visible = flse

With Document.Documents.Open("C:\Users\Desktop\セールのご案内(" & i & "様)(" & site & "会場).doc")

Set mytable1 = ActiveDocument.Tables(1)　　　　　　　　　　　　←このあたりで、エラーが発生しているようです。
mytable1.Cell(2, 2) = Sheets("Input").Range("B1").Value
mytable1.Cell(3, 2) = Sheets("Input").Range("B2").Value   
mytable1.Cell(4, 2) = Sheets("Input").Range("B3").Value
mytable1.Cell(5, 2) = Sheets("Input").Range("B4").Value

End With

Document.Quit savechanges = False

MsgBox "「セールのご案内(" & i & "様)(" & site & "会場).doc」を作成しました。"

End If

byebye:　　　　　　
Set mytable1 = Nothing
Set mytable4 = Nothing
Set objIE = Nothing
Set Document = Nothing
Set Ex = Nothing

End Sub
```


### 補足情報（FW/ツールのバージョンなど）

ファイルパスや適当なものを一応書いているだけなので、気にしないでください。

VBA エラー 462

# 実現したいこと
エクセルの＜検索文字列＞シートのA列に列挙されている検索文字列群（A1からA2、A3、、、に検索したい文字が入力されています）がwordファイルの文章中に使われているかそれぞれ検索し、出現ページ・行を＜結果＞シートに出力したい。

# エラー・回避したいこと
wordファイルの文章中の検索対象文字列にルビがふられていた場合、無限ループになってしまう。
例）「回避」が検索文字列で、wordファイルの文章のどこかで「回避」という文字が使われており、さらに「かいひ」とwordのルビ機能を使ってルビがふられていた場合に、無限ループになって固まってしまいます。
いろいろ調べてみましたが自分の力では回避できなかったのでこちらで質問させていただきます。

# コード

maxRowは＜検索文字列＞シートの最終行番号が格納
iRowは＜結果＞シートの結果を書き出す開始行番号が格納
```vba
    For i = 1 To maxRow
        wd = ThisWorkbook.Worksheets("検索文字列").Range("A" & i + 1).Value
        With wdApp.Selection
            .Find.Text = wd
            .Find.Forward = True
            .Find.MatchWholeWord = True
            .Find.MatchCase = True
            .Find.Wrap = wdFindContinue
            Do While .Find.Execute
                p = .Range.Information(wdActiveEndPageNumber)
                l = .Range.Information(wdFirstCharacterLineNumber)
                With ThisWorkbook.Worksheets("結果")
                    .Range("A" & iRow) = p & "P、" & l & "行目"
                    .Range("B" & iRow) = wd
                End With
                iRow = iRow + 1
            Loop
        End With
    Next

```
# 環境
Excel 2016、Word 2016、VBA 7.1

【VBA】ExcelからWord操作：文字列を検索して結果出力したい

Excel2010 VBAにて、Word文章から指定行の文章を抽出するマクロを作成しているのですが
Word文章のヘッダーファイルに記載している文字列を抽出できる関数が見つからず困っています。

具体的な手順としては

Excelファイルにて、Wordファイルのフルパスを入力・実行ボタンを押下
↓
指定のWordファイルをオープン
↓
ヘッダー文章と指定行を変数に格納
↓
EXCELファイルに転記

を実現させたいです。

ヘッダーファイルの文字列と指定行の文字列抽出が可能な
関数をご存知の方いらっしゃいましたら
ご教授のほど宜しくお願い致します。

```lang-VBA
sub WORD文章抽出マクロ()

    'WORDファイルオープン
    Dim myWord As Word.Document
    Set myWord = GetObject("C:\Word2013Data\指定WORDファイル.docx")
    myWord.Application.Visible = True

    'ヘッダーファイルの文字列抽出を行いたい

    '指定行の文字列抽出を行いたい

    worksheets("WORDからの抽出").cells(1,"A") = ヘッダーファイル文字列
    worksheets("WORDからの抽出").cells(2,"A") = 指定行文字列    
    
end sub
```

Excel VBAからWord文章を抽出したい

Microsoft Excel/Word Version 2013-2016

フォルダの中にあるWordファイルの中から特定の文字列を探し出し、前後の範囲を広げて抽出した文字列をExcelに出力したいのですが、

```VBA
objSelection.Paragraphs.first.Range.Text
```
とすると欲しい範囲までとれません、
行数やページ単位で取得する方法は分かったのですが、チルダが付いた変なファイルを読み込んだ時などにエラーが発生すると致命的な問題が起きることがあるため用いたくありません。

文字列取得範囲を広げて指定する良い方法はないでしょうか?
よろしくお願いします。

```VBA
Sub DocParagraphGet()
'参考　https://technet.microsoft.com/ja-jp/library/ee692875.aspx

  Dim wdApp As Object  ' Word.Application
  Dim wDoc As Object 'Word.Document
  Dim objFso As Object
  Dim objFolder As Object
  Dim objSelection As Object
  Dim sBookName As String '出力ブック名
  Dim objWb As Workbook
  Dim sOrgPath As String, sRetPath As String, sKeyWord As String
  Dim iParagNum '段落数
  
  
  Set wdApp = CreateObject("Word.Application")
  wdApp.Application.Visible = True '可視化　表示しなければ特に必要なし

  sOrgPath = ThisWorkbook.Sheets("フォーム").Range("B13") & "\"
  sRetPath = ThisWorkbook.Sheets("フォーム").Range("B14") & "\"
  iParagNum = ThisWorkbook.Sheets("フォーム").Range("B15")
  sKeyWord = "規格"
  sBookName = Format(Now, "yymmddhhmm") & "_Wordからの出力" & ".xlsx"
   
  Set objFso = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFso.GetFolder(sOrgPath)
  Set objWb = Workbooks.Add
  objWb.SaveAs (sRetPath & sBookName)

  objWb.Sheets.Add Before:=Sheets(1)
  r = 0
  For Each f In objFolder.Files
    
    sxx = Right(f.Name, 5)
    If 0 < InStr(sxx, ".doc") Then
      r = r + 1
      objWb.Sheets(1).Cells(r, 1) = f.Name
      Set wDoc = wdApp.documents.Open(sOrgPath & "\" & f.Name, True) '読み取りモードで開く
      Set objSelection = wdApp.Selection
      objSelection.Find.Text = sKeyWord
      objSelection.Find.Forward = True
      If objSelection.Find.Execute Then
        r = r + 1
        objWb.Sheets(1).Cells(r, 2) = objSelection.Paragraphs.first.Range.Text
      Else
        objWb.Sheets(1).Cells(r, 2) = "なし"
      End If
      wdApp.documents.Close
    End If  

   Next f
  
Set objFso = Nothing
Set objFolder = Nothing
Set wdApp = Nothing
  
  
End Sub
```