在Excel VBA中使某些文本粗体

时间:2016-04-03 18:22:12

标签: excel vba excel-vba

我正在使用VBA将excel表导出为单词。 word文档有一个书签。代码是这样的,首先它将TYPE写为标题,然后在该TYPE下写下所有描述。我希望标题是粗体和格式化的。我有以下代码但它不起作用。如果有人可以提出建议。

If Dir(strPath & "\" & strFileName) <> "" Then

    'Word Document open
    On Error Resume Next
    Set objWDApp = GetObject(, "Word.Application")
    If objWDApp Is Nothing Then Set objWDApp = CreateObject("Word.Application")
    With objWDApp
        .Visible = True 'Or True, if Word is to be indicated
        .Documents.Open (strPath & "\" & strFileName)
        Set objRng = objWDApp.ActiveDocument.Bookmarks("Bookmark").Range

        .Styles.Add ("Heading")
        .Styles.Add ("Text")

        With .Styles("Heading").Font

            .Name = "Arial"
            .Size = 12
            .Bold = True
            .Underline = True
        End With

        With .Styles("Text").Font

            .Name = "Arial"
            .Size = 10
            .Bold = False
            .Underline = False
        End With


    End With
    On Error GoTo 0

    i = Start_Cell 
    idx(1) = i 
    n = 2 
    Do ' Search for first empty cell in the table
        i = i + 1


        If i > Start_Cell + 1 And Cells(i, QB_Type).Value = Cells(i - 1, QB_Type) Then GoTo Loop1
        idx(n) = i
        n = n + 1

循环1:

    Loop Until IsEmpty(Cells(i + 1, QB_Type).Value)


    idxEnd = i 
    idx(n) = 9999 

    i = Start_Cell
    n = 1 
    Do

        If i = idx(n) Then
            strTMP = vbNewLine & vbNewLine & Cells(idx(n), QB_Type).Value & vbNewLine 


                  With objWDApp

               '.Selection.Font.Bold = True 'Type Bold (Doesnt Functions!?)

               .Selection.Styles ("Heading") 'I tried this as well but not functioning...gives an error here that object does not support this property

                WriteToWord objRng, strTMP 'Text written
            End With
            n = n + 1 
        End If

        strTMP = vbNewLine & Cells(i, QB_Description).Value & vbNewLine 
        With objWDApp
          '  .Selection.Font.Bold = False 'Description Not bold (Not functioning!?)
          .Selection.Styles("Text") 'This is also not functioning

            WriteToWord objRng, strTMP 'Text written
        End With
        i = i + 1 'Arbeitspunktzähler erhöhen
    Loop Until i > idxEnd

Public Sub WriteToWord(objRng, text) With objRng .InsertAfter text End With End Sub

1 个答案:

答案 0 :(得分:0)

here

尝试.Selection.Style.Name = "Heading"

修改2

以下代码按预期工作。您需要对其进行修改以满足您的需求。我成功添加了文本并将其加粗到现有的word文档。

Option Explicit

Public Sub Test()
    '   Add a reference to Microsoft Word x.0 Object Library for early binding and syntax support
    Dim w As Word.Application
    If (w Is Nothing) Then Set w = New Word.Application

    Dim item As Word.Document, doc As Word.Document

    '   If the document is already open, just get a reference to it
    For Each item In w.Documents
        If (item.FullName = "C:\Path\To\Test.docx") Then
            Set doc = item
            Exit For
        End If
    Next

    '   Else, open the document
    If (doc Is Nothing) Then Set doc = w.Documents.Open("C:\Path\To\Test.docx")

    '   Force change Word's default read-only/protected view
    doc.ActiveWindow.View = wdNormalView

    '   Delete the preexisting style to avoid an error of duplicate entry next time this is run
    '   Could also check if the style exists by iterating through all styles. Whichever method works for you
    doc.Styles.item("MyStyle").Delete
    doc.Styles.Add "MyStyle"

    With doc.Styles("MyStyle").Font
        .Name = "Arial"
        .Size = 12
        .Bold = True
        .Underline = wdUnderlineSingle
    End With

    '   Do your logic to put text where you need it
    doc.Range.InsertAfter "This is another Heading"

    '   Now find that same text you just added to the document, and bold it.
    With doc.Content.Find
        .Text = "This is another Heading"
        .Execute
        If (.Found) Then .Parent.Bold = True
    End With

    '   Make sure to dispose of the objects. This can cause issues when the macro gets out mid way, causing a file lock on the document
    doc.Close
    Set doc = Nothing
    w.Quit
    Set w = Nothing

End Sub

Successful heading addition, in bold.

通过添加对象库的引用,可以获得intellisense支持和编译错误。它可以帮助您在开发早期确定Styles不是Word.Application对象的有效属性。