如何用vba批量将选中的多个工作表文本框中的文本替换为其它文本?

如何用vba批量替换excel工作表文本框中的内容?一文中介绍了如何将单个工作表中的文本框中的文本内容批量替换为其它内容。

如果直接使用如下的代码,会出现如下的提示:

拒绝访问。您的权限不足,无法完成此操作。

Sub exceloffice()
    '作者QQ:1722187970,微信:xycgenius,微信公众号exceloffice
    Dim oWK As Worksheet
    For Each oWK In Excel.ThisWorkbook.Windows(1).SelectedSheets
        Dim oSP As Shape
        With oWK
            sOldText = "弃方(到弃土坑K32+535.870"
            sNewText = "弃方(到弃土坑3合同K34+550"
            For Each oSP In .Shapes
                With oSP
                    '只替换文本框中的内容
                    If .Type = msoTextBox Then
                        '读取文本框原来的内容
                        sText = .TextFrame2.TextRange.Text
                        '输入替换后的内容
                        .TextFrame2.TextRange.Text = VBA.Replace(sText, sOldText, sNewText)
                    End If
                End With
            Next
        End With
    Next
    MsgBox "操作完成"
End Sub

需要将代码修改为如下的形式:

Sub exceloffice()
    '作者QQ:1722187970,微信:xycgenius,微信公众号exceloffice
    Dim oWK As Worksheet
    Dim arr()
    k = 1
    For Each oWK In Excel.ThisWorkbook.Windows(1).SelectedSheets
        ReDim Preserve arr(k)
        arr(k) = oWK.Name
        k = k + 1
    Next oWK
    Excel.ThisWorkbook.Worksheets(1).Activate
    For i = 0 To UBound(arr)
        Set oWK = Excel.ThisWorkbook.Worksheets(arr(i))
        Dim oSP As Shape
        With oWK
            sOldText = "弃方(到弃土坑K32+535.870"
            sNewText = "弃方(到弃土坑3合同K34+550"
            For Each oSP In .Shapes
                With oSP
                    '只替换文本框中的内容
                    If .Type = msoTextBox Then
                        '读取文本框原来的内容
                        sText = .TextFrame2.TextRange.Text
                        '输入替换后的内容
                        .TextFrame2.TextRange.Text = VBA.Replace(sText, sOldText, sNewText)
                    End If
                End With
            Next
        End With
    Next i
    Excel.ThisWorkbook.Worksheets(arr).Select
    MsgBox "操作完成"
End Sub

也就是先将选中的工作表存入数组,然后再用数组循环每个工作表执行文本框批量替换操作。

       

发表评论