Question

我一直在尝试编写一个宏，它将动态填充新工作表上的文本框，以及另一个工作表中单元格的值。

我已设法使用此功能：

Sub copyDetail()

' Define variables

Dim pre As Worksheet
Dim des As Worksheet

Set pre = Sheets("Presentation")
Set des = Sheets("Description")

Dim i As Integer
Dim lbl As String

' Scroll through labels and copy where boolean = 1

For i = 2 To 17
    If des.Cells(i, 2) = 1 Then
        lbl = des.Cells(i, 11)
        Sheets("Presentation").Select
        ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
        Selection.Text = lbl

    Else

    End If
Next i

End Sub

我基本上希望能够完全做到这一点，但不使用select一直，因为这会更改工作表并减慢我的代码（我还有许多其他子程序与此一起运行）。我尝试过使用以下方法来定义文本框：

Dim myLabel As Object
Set myLabel = pre.Shapes.Range(Array("TextBox 1"))

但后来我得到一个＆＃34;对象不支持这个属性或方法＆＃34;我试着打电话时出错：

myLabel.Text = lbl

Answer 1

您可以设置TextBox的文字，如下所示：

ActiveSheet.Shapes("TextBox 1").TextFrame.Characters.Text = "Hello world"

您可以在Sub中设置一个小帮助Module，以使代码可重复使用：

Public Sub SetTextBoxText(ws As Worksheet, strShapeName As String, strText As String)

    Dim shp As Shape

    On Error Resume Next
    Set shp = ws.Shapes(strShapeName)

    If Not shp Is Nothing Then
        shp.TextFrame.Characters.Text = strText
    Else
        Debug.Print "Shape not found"
    End If

End Sub

将单元格值复制到文本框vba

1 个答案: