如何根据 excel VBA 中形状（或文本框或图片）的移动更改单元格的值

Question

我没有接受过任何编码方面的培训，但过去曾设法使用我在网上找到的代码作为 excel 的一部分，或者使用宏或按钮等进行访问。这有点难弄清楚它是否有可能。

我一直在尝试在 excel 中找到一些方法来引用文本框或形状相对于单元格的位置（例如，图片一在单元格 A1 中，所以两者之间的 link制作）。

实际应用是：我指定了 class 个区域，例如Class A（面积为A1:A6）和Class B（面积为B1:B6），我有一张图片（或shape/text框）或其他东西每个单独的学习者。如果我将学习者图片放在单元格范围 A1:A6 内，图片应该以某种方式 link 与 class.

我在网上找到了一些我独立尝试过的代码并且它们可以工作（很抱歉没有引用 where/who 我从中找到它们），我想如果我能以某种方式将它们组合起来我可能是能够做我需要的。

首先是编写一个按钮来查看活动中的所有形状 sheet 并在某处列出它们的名称，我找到了两个部分：

Private Sub CommandButton1_Click()
Dim x&
With Sheets("sheet1")
For x = 1 To .Shapes.Count
Sheets("sheet2").Cells(x, 1).Value = .Shapes(x).Name
Next
End With
End Sub

Private Sub CommandButton3_Click()
Dim iCount As Integer
For iCount = 1 To ActiveSheet.Shapes.Count
Cells(iCount, 1).Value = ActiveSheet.Shapes(iCount).Name
Next iCount
End Sub

我还找到了 select 在某些单元格范围内找到的形状的代码：

Private Sub CommandButton5_Click()
Dim shp As Shape
Dim r As Range

Set r = Range("A1:A3")

For Each shp In ActiveSheet.Shapes
    If Not Intersect(Range(shp.TopLeftCell, shp.BottomRightCell), r) Is Nothing Then _
        shp.Select Replace:=False
Next shp
End Sub

另一个用于创建对单元格数组中所有形状的引用（据我所知）

Sub Shapepicker()

Dim s As Shape, sr As ShapeRange
    Dim Arr() As Variant
    Set mycell = Range("A:A")
    rrow = "A1"

i = 1
For Each s In ActiveSheet.Shapes
    If s.TopLeftCell = rrow Then
        ReDim Preserve Arr(1 To i)
        Arr(i) = s.Name
        i = i + 1
    End If
Next s

Set sr = ActiveSheet.Shapes.Range(Arr)

结束子

我试过将代码的科学怪人片段放在一起，将在特定单元格范围内找到的形状的名称放在某处，但由于我有限的知识无法使其发挥作用。

如有任何帮助，我们将不胜感激。

Answer 1

不确定您想要什么输出，但是使用 2 classes 这会将形状放在 A 列中的一个 class 和 B 列中的其他形状中。

Private Sub CommandButton1_Click()

Dim shp As Shape
Dim r1 As Range, r2 As Range

Set r1 = Range("C3:F5") 'class 1
Set r2 = Range("G12:H15") 'class 2

For Each shp In ActiveSheet.Shapes
    If Not Intersect(Range(shp.TopLeftCell, shp.BottomRightCell), r1) Is Nothing Then Cells(Rows.Count, 1).End(xlUp)(2).Value = shp.Name
    If Not Intersect(Range(shp.TopLeftCell, shp.BottomRightCell), r2) Is Nothing Then Cells(Rows.Count, 2).End(xlUp)(2).Value = shp.Name
Next shp

End Sub

如何根据 excel VBA 中形状（或文本框或图片）的移动更改单元格的值

How do I change a cell's value based on the movement of a shape (or textbox, or picture) in excel VBA

excel

vba

shapes