常連

### 実現したいこと
例として以下のようなWordファイルをHTMLファイルに出力
![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2024-07-04/4c758f18-7c37-44e2-bca0-a681ddde1171.png)

結果ソースイメージ
```
<h1>見出し１</h1>
<h2>見出し２</h2>
<p>サンプル<u>下線</u>サンプル</p>
<p>サンプル<b>マーク</b>サンプル</p>
<h1>見出し１</h1>
```

### 発生している問題・分からないこと
該当ソースコードの「under = .range.Text」等の .range.Text が取得できない。

また、何度かコードを修正する中で、文書内では見出し１テキストや見出し２テキストの位置はバラバラだが、出力すると一箇所に固まる（その場でループされている？）

### エラーメッセージ
```error
コンパイルエラー：メソッドまたはデータメンバーが見つかりません
```

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

```
Sub ExportToHTML()
  ' 出力ファイル名を指定
  Dim outputFileName As String
  outputFileName = "output.html"

  ' 出力ファイルを作成
  Dim outputDoc As Object
  Set outputDoc = CreateObject("htmlfile")

  ' ヘッダーを出力
  outputDoc.Write "<!DOCTYPE html>"
  outputDoc.Write "<html>"
  outputDoc.Write "<head>"
  outputDoc.Write "<meta charset='UTF-8'>"
  outputDoc.Write "<title>Document</title>"
  outputDoc.Write "</head>"
  outputDoc.Write "<body>"

  ' 変換元の Word 文書を開く
  Dim sourceDoc As Document
  Set sourceDoc = ActiveDocument

  ' <h1>タグを付与する
  With sourceDoc.Content.Find
    .ClearFormatting
    .Style = "見出し 1"
    .Execute
    While .Found
      Dim headOne As String
      headOne = .Parent.Text
      outputDoc.Write "<h1>" & headOne & "</h1>"
      .Execute ' 次の見出しを検索
    Wend
  End With

  ' <h2>タグを付与する
  With sourceDoc.Content.Find
    .ClearFormatting
    .Style = "見出し 2"
    .Execute
    While .Found
      Dim headTwo As String
      headTwo = .Parent.Text
      outputDoc.Write "<h2>" & headTwo & "</h2>"
      .Execute ' 次の見出しを検索
    Wend
  End With

  ' <p>タグを付与する
  Dim range As range
  For Each range In sourceDoc.StoryRanges
    With range.Find
    .ClearFormatting
    .Style = "標準"
    .Execute
    While .Found
      outputDoc.Write "<p>"

      ' 下線が引かれているテキストに<u>タグを付与する
      If range.Font.Underline = wdUnderlineSingle Then
        Dim under As String
        under = .range.Text
       outputDoc.Write "<u>" & under & "</u>"

        ' range.InsertBefore "<span class=""under"">"
        ' range.InsertAfter "</span>"
      ' 蛍光ペンがついているテキストに<b>タグを付与する
      ElseIf range.HighlightColorIndex <> wdNoHighlight Then
        Dim mark As String
        mark = .range.Text
        outputDoc.Write "<b>" & mark & "</b>"

        ' range.InsertBefore "<span class=""mark"">"
        ' range.InsertAfter "</span>"
      ' その他のテキストに<p>タグを付与する
      Else
        Dim nomal As String
        nomal = .range.Text
        outputDoc.Write nomal

        ' range.InsertBefore "<p>"
        ' range.InsertAfter "</p>"
      End If
      .Execute

      outputDoc.Write "</p>"
    Wend
    End With
  Next range

  ' フッターを出力
  outputDoc.Write "</body>"
  outputDoc.Write "</html>"

  ' ファイルを保存
  Dim fs As Object
  Set fs = CreateObject("Scripting.FileSystemObject")
  Dim f As Object
  Set f = fs.CreateTextFile(outputFileName, True)
  f.Write outputDoc.body.innerHTML
  f.Close
End Sub
```

### 試したこと・調べたこと
- [x] teratailやGoogle等で検索した
- [x] ソースコードを自分なりに変更した
- [ ] 知人に聞いた
- [ ] その他

##### 上記の詳細・結果
----------

### 補足
特になし

Word VBAにてテキスト取得が上手くできない

### 前提・実現したいこと

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のプロキシサーバーに接続しています」を出さないためには

# 実現したいこと
エクセルの＜検索文字列＞シートの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操作：文字列を検索して結果出力したい

### 前提・実現したいこと
テンプレートとなるWordファイルの中に、
「テキスト＋表」のセットが存在します。

ExcelVBAから、
それらをまとめて（全選択）コピーし、Wordファイルの末尾に張り付けて増やす。
といったことを行いたい。

### 試したこと
ExcelVBAで以下のWordマクロを再現したかったが、Selectionがわからなく、うまく動きませんでした。
※末尾貼り付け処理が入っていないのでテストコードとなります
```Word
Sub Macro1()
    Selection.WholeStory
    Selection.Copy
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
End Sub
```
ExcelVBAでは、以下コードで、表の取得・貼り付けを行っておりますが、表自体(書式)のコピーが行われず、値のみが張り付けられてしまいます。
```Excel
wordObj.Bookmarks("\EndOfDoc").Range.InsertAfter wordObj.Tables(1).Range
```

### 実現したいこと
テキストや表の書式自体が保たれた状態で、コピーペーストできれば、手法は問いません。
Word側にマクロを入れても大丈夫ですが、トリガーとなるのはExcelでありたいです。

何卒、よろしくお願いいたします。

### 補足情報
Word2013
Excel2013

Excel VBAからwordの全選択→貼り付けを行いたい

### 実現したいこと
VBAでWordの画像の差し替えをしたい

### 前提

wordVBAで画像の差し替えを行うプログラムを作っています。
画像は行内ではありません。

### 発生している問題・エラーメッセージ

画像を差し替えることができず困っています。
おそらく18行目部分が誤っているものだと思われます。
Selection.ShapeRange.Fill.UserPicture picpath

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

```VBA
Sub picreplace()
    Dim doc As Document
    Dim shape   As shape
    
    Set doc = ActiveDocument
    
    Dim picpath As String
    picpath = "ファイルパス"
    
    Dim j As Byte
    
    For j = 1 To ActiveDocument.Shapes.Count
    
        Set shape = doc.Shapes(j)
        
        If shape.Type = msoPicture Then
            shape.Select
            Selection.ShapeRange.Fill.UserPicture picpath
   
        End If
        
        Set shape = Nothing
    Next j
    
    Set doc = Nothing
    
    
End Sub

```

### 試したこと
差し替え前の画像を選択することはできているようです。

### 追記
```vba
    If shape.Type = msoPicture Then
        shape.Select
        shleft = shape.Left
        shtop = shape.Top
        shape.Delete
        doc.Shapes.AddPicture FileName:=picpath, Left:=shleft, Top:=shtop
        
    End If

```
上記のように、削除したあと同じ位置に追加する処理に変更したのですが、変更される画像と変更されない画像があります。

VBAでWordの画像の差し替え

### 前提・実現したいこと
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

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
```