常連

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

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

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

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