注册 登录
编程论坛 Excel/VBA论坛

请问在WPS 表格中如何用VBA将这些从网页拷贝过来的文本框控件、单选框控件删除但保留里边的内容?

sun2038 发布于 前天 16:42, 42 次点击
我试过用下面的代码来删除,但不成功,请大神指出问题在那?

Sub DeleteControlsAndKeepText()
    Dim sht As Worksheet
    Dim oleObj As OLEObject
    Dim shp As Shape
    Dim controlText As String
    Dim targetCell As Range
   
    Set sht = ActiveSheet ' 处理当前活动工作表
    Application.ScreenUpdating = False
   
    ' 处理ActiveX控件(如网页中的单选框和文本框)
    For Each oleObj In sht.OLEObjects
        If TypeName(oleObj.Object) = "OptionButton" Then
            ' 获取单选框的标题和位置
            controlText = oleObj.Object.Caption
            Set targetCell = oleObj.TopLeftCell
            targetCell.Value = controlText
            oleObj.Delete
        ElseIf TypeName(oleObj.Object) = "TextBox" Then
            ' 获取文本框的内容和位置
            controlText = oleObj.Object.Text
            Set targetCell = oleObj.TopLeftCell
            targetCell.Value = controlText
            oleObj.Delete
        End If
    Next oleObj
   
    ' 处理表单控件(旧式控件,如Excel表单元素)
    For Each shp In sht.Shapes
        If shp.Type = msoFormControl Then
            Select Case shp.FormControlType
                Case xlOptionButton
                    ' 获取单选框标题
                    controlText = shp.ControlFormat.Caption
                    Set targetCell = shp.TopLeftCell
                    targetCell.Value = controlText
                    shp.Delete
                Case xlTextBox
                    ' 尝试获取文本框内容(可能需要适配)
                    On Error Resume Next ' 防止属性不存在报错
                    controlText = shp.TextFrame.Characters.Text
                    If Err.Number <> 0 Then controlText = ""
                    Err.Clear
                    On Error GoTo 0
                    Set targetCell = shp.TopLeftCell
                    targetCell.Value = controlText
                    shp.Delete
            End Select
        End If
    Next shp
   
    Application.ScreenUpdating = True
    MsgBox "处理完成!控件已删除,内容保留在对应单元格。"
End Sub
0 回复
1