VBA for Word operation

Option Explicit

'[ツール] → [参照設定] → [Microsoft Word XX.X Object Library]をチェック → [OK]

Sub OpenDoc()
    Dim app As New Word.Application
    app.Visible = True
    
    'Documentを開く
    Dim doc As Word.Document
    Set doc = app.Documents.Open("C:\Users\kazuya\Desktop\folder1" & "\" & "sdxs.docx")
    'doc.Windows(1).Visible = False
    
    'Set app = Nothing 'オブジェクトを開放
End Sub

Sub DocsVisible()
   Dim doc As Word.Document
   Dim docs As Word.Documents

   
   Set docs = GetDocsOpen
   If docs Is Nothing Then Exit Sub
   
   For Each doc In docs
      doc.Windows(1).Visible = True
   Next
End Sub

Sub ReadWordToSheet()
   Dim i As Integer, p As Long, cnt As Integer
   Dim doc As Word.Document, docs As Word.Documents
   Dim para As Word.Paragraph, table As Word.table
   Dim shThis As Worksheet
   Dim ceOutPara  As Range, ceOutTable As Range
   Dim txt As String
   
   Set shThis = ActiveSheet
   
   Set docs = GetDocsOpen
   If docs Is Nothing Then Exit Sub
   Set doc = docs(1)
    
   shThis.Cells.Clear
   
   Set ceOutPara = shThis.Cells(2, 2)
   Set ceOutTable = shThis.Cells(2, 6)
   
   Application.ScreenUpdating = False
   p = 1
   ceOutPara.Value = "Paragraph"
   For Each para In doc.Paragraphs
      If para.Range.Information(wdWithInTable) = False Then
         ceOutPara.Offset(p, 0).Value = p
         
         txt = para.Range.Text
         If Left(txt, 1) = Chr(10) Or Left(txt, 1) = Chr(13) Then
            ceOutPara.Offset(p, 1).Value = ""
         Else
            ceOutPara.Offset(p, 1).Value = para.Range.Text
         End If
         p = p + 1
      End If
      
      If p > 1000 Then Exit For
   Next
   
   cnt = 0
   For Each table In doc.Tables
      cnt = cnt + 1
      ceOutTable.Value = "Table" & cnt
      table.Range.Copy
      ceOutTable.Offset(1, 0).Select
      shThis.PasteSpecial Format:="HTML", NoHTMLFormatting:=True
      
      For i = 1 To 50
         Set ceOutTable = ceOutTable.Offset(0, 1)
         If ceOutTable.End(xlDown).Row >= 1000 Then
            Set ceOutTable = ceOutTable.Offset(0, 1)
            Exit For
         End If
      Next i
   Next table
   Application.ScreenUpdating = True
End Sub

Sub WordOpe()
    'Wordを立ち上げ
    Dim app As New Word.Application
    app.Visible = True
    
    'Documentを開く
    Dim doc As Word.Document
    Set doc = app.Documents.Open(ThisWorkbook.Path & "\" & "word1.docx")
    
    Set app = Nothing 'オブジェクトを開放
End Sub

Function GetDocsOpen() As Word.Documents
   Dim app As New Word.Application
   
   On Error GoTo Label1
   Set app = GetObject(Class:="Word.Application")
   Set GetDocsOpen = app.Documents
   Set app = Nothing
   Exit Function
   
Label1:
   Set GetDocsOpen = Nothing
   Set app = Nothing
End Function


Function GetDocParas(doc As Word.Document) As String()
   Dim para As Word.Paragraph
   Dim p As Integer
   Dim pMax As Integer
   
   pMax = 1000
   ReDim aryPara(1 To pMax) As String
   p = 0
   For Each para In doc.Content.Paragraphs
      p = p + 1
      aryPara(p) = para.Range.Text
      If p > pMax Then Exit For
   Next
   ReDim Preserve aryPara(1 To p)
   GetDocParas = aryPara
   Set para = Nothing
End Function