VBA 단어 자막 추가

Question

VBA를 사용하여 단어 문서에 캡션을 추가하려고합니다. 다음 코드를 사용하고 있습니다. 데이터는 시트 당 하나씩 Excel 스프레드 시트의 표로 시작합니다. 문서라는 단어에 테이블 목록을 생성하려고합니다.

다음 코드로드 워드 템플릿을 편집 시작 :

Set objWord = CreateObject("Word.Application") 
objWord.Visible = True 
Set objDoc = objWord.Documents.Add("Template path") 

' Moving to end of word document 
objWord.Selection.EndKey END_OF_STORY, MOVE_SELECTION 

' Insert title 
objWord.Selection.Font.Size = "16" 
objWord.Selection.Font.Bold = True 
objWord.Selection.TypeText ("Document name") 
objWord.Selection.ParagraphFormat.SpaceAfter = 12 
objWord.Selection.InsertParagraphAfter 

다음 코드는 워크 시트의 시트를 통해 반복하고 테이블과 헤더를 추가합니다.

' Declaring variables 
Dim Wbk As Workbook 
Dim Ws As Worksheet 
Dim END_OF_STORY As Integer: END_OF_STORY = 6 
Dim MOVE_SELECTION As Integer: MOVE_SELECTION = 0 
Dim LastRow As Integer 
Dim LastColumn As Integer 
Dim TableCount As Integer 
Dim sectionTitle As String: sectionTitle = " " 

' Loading workbook 
Set Wbk = Workbooks.Open(inputFileName) 

' Moving to end of word document 
objWord.Selection.EndKey END_OF_STORY, MOVE_SELECTION 

' Looping through all spreadsheets in workbook 
For Each Ws In Wbk.Worksheets 

' Empty Clipboard 
Application.CutCopyMode = False 


objWord.Selection.insertcaption Label:="Table", title:=": " & Ws.Range("B2").Text 

셀 B2에는 다음 텍스트가 있습니다. "표 1 : 요약". 문서라는 단어가이 텍스트를 반영하는 헤더를 갖기를 희망합니다. 문제는 테이블 번호가 두 번 반복되고 결과가 나타납니다 : "Table 1 : Table 1 : Summary". 나는 다음과 같은 변경을 시도했다. 둘 다 오류를 낳았다.

내가 뭘 잘못하고 있으며, 더 일반적으로 삽입 방법은 어떻게 작동합니까?

이 글을 읽으려고했지만 구문에 혼란 스럽습니다. MS Word에서 캡션 스타일을 사용하는 내장 기능의

Answer 1

한

https://msdn.microsoft.com/en-us/vba/word-vba/articles/selection-insertcaption-method-word

은 동적 문서의 조정 적용됩니다 번호 자동입니다. 명시 적으로 테이블 번호 매기기를 관리하려고합니다. 괜찮습니다.하지만 코드에서 Word의 자동으로 유용한 번호 매기기를 취소해야합니다.

Excel에서 작업하면서 아래 코드를 사용하여 캡션이있는 테스트 문서를 설정 한 다음 레이블의 자동 부분을 제거하는 빠른 루틴을 테스트했습니다. 이 예제 코드는 독립 실행 형 테스트로 작동하여 사용자가 자신의 코드에 적응하도록 남겨 둡니다.

초기 test 하위는 Word.Application과 Document 개체를 간단히 설정 한 다음 다음 단락으로 된 세 개의 테이블을 만듭니다. 각 테이블에는 자체 캡션이 있습니다 (Word의 자동 레이블 지정으로 인해 레이블이 두 배로 표시됨). 이 코드는 MsgBox을 일시 중지하므로 수정되기 전에 문서를 살펴볼 수 있습니다.

그런 다음 코드는 돌아갑니다 및 Caption 스타일에 대한 전체 문서를 검색하고 이중 라벨을 찾기 위해 스타일 내의 텍스트를 검사합니다. 캡션 텍스트에서 두 개의 콜론 ":"이 발견되면 이중 레이블이 있다고 가정했습니다. 첫 번째 레이블 (첫 번째 콜론까지 및 그 전까지)이 제거되고 텍스트가 바뀝니다. 그것으로, 결과 문서는 다음과 같습니다

코드 : 우리는 코드의 자세한 내용을 볼 필요가

Option Explicit 

Sub test() 
    Dim objWord As Object 
    Dim objDoc As Object 
    Set objWord = CreateObject("Word.Application") 
    objWord.Visible = True 
    Set objDoc = objWord.documents.Add 

    Dim newTable As Object 
    Set newTable = objDoc.Tables.Add(Range:=objDoc.Range, NumRows:=3, NumColumns:=1) 
    newTable.Borders.Enable = True 
    newTable.Range.InsertCaption Label:="Table", Title:=": Table 1: summary xx" 
    objDoc.Range.InsertParagraphAfter 
    objDoc.Range.InsertAfter "Lorem ipsum" 

    objDoc.Characters.Last.Select 
    objWord.Selection.Collapse 
    Set newTable = objDoc.Tables.Add(Range:=objWord.Selection.Range, NumRows:=3, NumColumns:=2) 
    newTable.Range.InsertCaption Label:="Table", Title:=": Table 2: summary yy" 
    newTable.Borders.Enable = True 
    objDoc.Range.InsertParagraphAfter 
    objDoc.Range.InsertAfter "Lorem ipsum" 

    objDoc.Characters.Last.Select 
    objWord.Selection.Collapse 
    Set newTable = objDoc.Tables.Add(Range:=objWord.Selection.Range, NumRows:=3, NumColumns:=3) 
    newTable.Range.InsertCaption Label:="Table", Title:=": Table 3: summary zz" 
    newTable.Borders.Enable = True 
    objDoc.Range.InsertParagraphAfter 
    objDoc.Range.InsertAfter "Lorem ipsum" 

    MsgBox "document created. hit OK to continue" 

    RemoveAutoCaptionLabel objWord 
    Debug.Print "-----------------" 
End Sub 

Sub RemoveAutoCaptionLabel(ByRef objWord As Object) 
    objWord.Selection.HomeKey 6 'wdStory=6 
    With objWord.Selection.Find 
     .ClearFormatting 
     .Replacement.ClearFormatting 
     .Style = "Caption" 
     .Text = "" 
     .Forward = True 
     .Wrap = 1   'wdFindContinue=1 
     .MatchCase = False 
     .MatchWholeWord = False 
     .MatchWildcards = False 
     .MatchSoundsLike = False 
     .MatchAllWordForms = False 
     Do While .Execute() 
      RemoveDoubleLable objWord.Selection.Range 
      objWord.Selection.Collapse 0 'wdCollapseEnd=0 
     Loop 
    End With 
End Sub 

Sub RemoveDoubleLable(ByRef capRange As Object) 
    Dim temp As String 
    Dim pos1 As Long 
    Dim pos2 As Long 
    temp = capRange.Text 
    pos1 = InStr(1, temp, ":", vbTextCompare) 
    pos2 = InStr(pos1 + 1, temp, ":", vbTextCompare) 
    If (pos1 > 0) And (pos2 > 0) Then 
     temp = Trim$(Right$(temp, Len(temp) - pos1 - 1)) 
     capRange.Text = temp 
    End If 
End Sub