在如何用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
也就是先将选中的工作表存入数组,然后再用数组循环每个工作表执行文本框批量替换操作。


发表评论