需要帮助使这个加粗代码同时适用于多个VBA工作表

时间:2017-03-28 13:00:26

标签: excel vba excel-vba

我目前必须同时发送多个字母,并且通常只替换一个单元格中的一个或两个单词。问题是我需要将这些单词加粗,在150个工作表上单独使用这个宏会很繁琐。我对编码很新,并尝试在线搜索以编辑我的代码,但我尝试的所有内容似乎只会改变我当前的工作表。我希望得到一个固定的代码,并对变化进行解释,这样我就可以了解将来如何解决这个问题。

Sub FindAndBold()

    Dim ws As Worksheet
    Dim sFind As String
    Dim rCell As Range
    Dim rng As Range
    Dim lCount As Long
    Dim iLen As Integer
    Dim iFind As Integer
    Dim iStart As Integer

    On Error Resume Next
    Set rng = ActiveSheet.UsedRange. _
      SpecialCells(xlCellTypeConstants, xlTextValues)
    On Error GoTo ErrHandler
    If rng Is Nothing Then
        MsgBox "There are no cells with text"
        GoTo ExitHandler
    End If

    sFind = InputBox( _
      Prompt:="What do you want to BOLD?", _
      Title:="Text to Bold")
    If sFind = "" Then
        MsgBox "No text was listed"
        GoTo ExitHandler
    End If

    iLen = Len(sFind)
    lCount = 0

    For Each rCell In rng
        With rCell
            iFind = InStr(.Value, sFind)
            Do While iFind > 0
                .Characters(iFind, iLen).Font.Bold = True
                lCount = lCount + 1
                iStart = iFind + iLen
                iFind = InStr(iStart, .Value, sFind)
            Loop
        End With
    Next

    If lCount = 0 Then
        MsgBox "There were no occurrences of" & _
          vbCrLf & "' " & sFind & " '" & _
          vbCrLf & "to bold."
    ElseIf lCount = 1 Then
        MsgBox "One occurrence of" & _
          vbCrLf & "' " & sFind & " '" & _
          vbCrLf & "was made bold."
    Else
        MsgBox lCount & " occurrences of" & _
          vbCrLf & "' " & sFind & " '" & _
          vbCrLf & "were made bold."
    End If

ExitHandler:

    Set rCell = Nothing
    Set rng = Nothing
    Exit Sub

ErrHandler:

    MsgBox Err.Description
    Resume ExitHandler

End Sub

0 个答案:

没有答案