Question

我在谷歌上搜索过，但我仍然无法找到解决方案。我是Excel VBA的新手，我正在寻找一些VBA代码来链接从sheet1到sheet2的Excel形状。

示例：

我有10个自动形状，颜色为蓝色＆amp; sheet1中的黄色，我需要与sheet1相关联的整个sheet2。如果sheet1自动图形颜色变为红色，sheet2自动图形将相应地更改颜色。

我怎样才能做到这一点？

Answer 1

在你的问题的背景下，形状是独立的＆＃34;对象。所以你需要知道它们。您可以使用以下代码获取形状的名称（从CommandButton1中的Sheet1开始运行）：

Private Sub CommandButton1_Click()
Dim Shp As Shape
i = 1
For Each Shp In Worksheets("Sheet1").Shapes
    Worksheets("Sheet3").Cells(i, 1) = i
    Worksheets("Sheet3").Cells(i, 2) = "Sheet1"
    Worksheets("Sheet3").Cells(i, 3) = Shp.Name
    i = i + 1
Next Shp

For Each Shp In Worksheets("Sheet2").Shapes
    Worksheets("Sheet3").Cells(i, 1) = i
    Worksheets("Sheet3").Cells(i, 2) = "Sheet2"
    Worksheets("Sheet3").Cells(i, 3) = Shp.Name
    i = i + 1
Next Shp
End Sub

一旦知道了形状名称，就需要对它们进行vinculate。我使用两个数组myarray1和myarray2执行此操作（在此代码中，vinculation是＆＃34;硬编码＆＃34;在数组中）。然后，以下代码（从Command Button2运行）将扫描所有形状，如果shape.name在myarray1中，则它将颜色设置为myarray2的相应形状。

Private Sub CommandButton2_Click()
Dim Shp As Shape
Dim myarray1 As Variant
Dim myarray2 As Variant

'First element of myarray1 will correspond to first element of myarray2, and so on
'myarray1: name of shapes of Sheet1
'myarray2: name of shapes of Sheet2
myarray1 = Array("Oval 5", "Oval 6", "Oval 7")
myarray2 = Array("Oval 4", "Rectangle 7", "Oval 8")

    For Each Shp In Worksheets("Sheet1").Shapes
        If IsInArray(Shp.Name, myarray1) Then
            TheColor = Shp.Fill.ForeColor.RGB

              For i = LBound(myarray2) To UBound(myarray2)
                If StrComp(Shp.Name, myarray1(i), vbTextCompare) = 0 Then
                    Worksheets("Sheet2").Shapes(myarray2(i)).Fill.ForeColor.RGB = TheColor
                  Exit For
                End If
              Next i
        End If
    Next Shp
End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
  IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

此外，您可能需要添加错误处理程序。

将Excel形状从Sheet1链接到Sheet2

1 个答案: