将不同的字样式计数为csv文件

时间:2018-08-24 05:42:05

标签: vba ms-word

我需要在Word文档中将不同的字样式计数为CSV文件,并带有列标题,样式名称和样式计数。

我的VB代码,用于输出为Word文档中特定样式的弹出窗口。

Sub Count()
Dim l As Long
ResetSearch
With ActiveDocument.Range.Find
   .Style = "Strong" 'Replace with the name of the style you are counting
   While .Execute
      l = l + 1
      If l > ActiveDocument.Range.Paragraphs.Count Then
         Stop
      End If
   Wend
End With
MsgBox l
ResetSearch
End Sub

Public Sub ResetSearch()
With Selection.Find
   .ClearFormatting
   .Replacement.ClearFormatting
   .Text = ""
   .Replacement.Text = ""
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
   ' plus some more if needed
   .Execute
End With
End Sub

输出我正在将样式计数作为弹出消息框。

请建议,单词中的不同样式不仅会增强csv格式列标题中的任何类型的样式计数,包括样式名称和样式计数

1 个答案:

答案 0 :(得分:0)

尝试以下操作。不过,不清楚CSV格式输出的含义。

Sub GetDocStyles()
Application.ScreenUpdating = False
Dim StrStl As String, StrStls As String, j As Long
StrStls = "Style" & vbTab & "Count"
With ActiveDocument.Range
  .Font.Hidden = True
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = True
    .Font.Hidden = True
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Text = "?"
    .Replacement.Text = ""
    .Execute
  End With
  Do While .Find.Found = True
    StrStl = .Paragraphs.First.Style
    StrStls = StrStls & Chr(11) & StrStl
    j = 0
    With .Duplicate
      With .Find
        .Style = StrStl
        .Text = ""
        .Execute
      End With
      Do While .Find.Found = True
        j = j + 1
        .Font.Hidden = False
        .Find.Execute
      Loop
    End With
    StrStls = StrStls & vbTab & j
    .Find.Execute
    DoEvents
  Loop
End With
With ActiveDocument.Range
  .InsertAfter vbCr & "The following paragraph Styles were found in the document:" & Chr(11) & StrStls
  .Paragraphs.Last.TabStops.Add Position:=InchesToPoints(1.5), Alignment:=wdAlignTabRight
End With
Application.ScreenUpdating = True
End Sub