Question

我在工作表中有8个矩形。 4具有相同的尺寸而另外4具有相同的尺寸（因此2组矩形，每组具有另一尺寸）。到目前为止，我的代码看起来像这样（相同大小的2个矩形的剪切）：

Public Sub CommandButton1_Click()
Dim Nut As Shape
Dim Nut2 As Shape
Dim Nutbreite As Double
Dim Nutbreite2 As Double

Nutbreite = (Sheets("Tabelle1").Range("C3").Value)
    Set Nut = ThisWorkbook.Sheets("Tabelle1").Shapes("Gruppieren 10")
    With Nut
        .Width = Nutbreite
        .Left = 400
    End With

Nutbreite2 = (Sheets("Tabelle1").Range("C4").Value)
    Set Nut2 = ThisWorkbook.Sheets("Tabelle1").Shapes("Gruppieren 12")
    With Nut2
        .Width = Nutbreite2
        .Left = 400
    End With

 End sub

因此，我重复16次反应，这是一个非常愚蠢的解决方案。但是，由于我是一个小时候的初学者，我不能做得更好。我认为有两种可能的解决方案： 1.将2个列表/数组设为la {Nut1，Nut2 ...}并每次使用with函数 2.或者在开头用一个矩形的参数定义2个子，然后再调用它们。

我已经尝试了几个小时的选择，但没有相处。简单的解决方案Nut = Nut2既不起作用...... :( 问题是：如何减少16＆＃34; With ... End With＆＃34;表达式，如果它们都具有相同的参数但是地址不同的矩形??

Answer 1

对矩形的名称及其所在的顺序做出一些假设。我有以下代码。

Private Sub CommandButton1_Click()

    Dim i, j, k As Integer
    Dim width As Double

    j = 3 'Cell value locator
    k = 9 'Increment shape names, assumption "Gruppieren 10", "Gruppieren 12", "Gruppieren 14", etc

    For i = 1 To 16

        If Not i Mod 2 = 0 Then

            width = (Sheets("Tabelle1").Range("C" + Trim(Str(j)).Value)) ' grab the value from C3

        Else

            width = (Sheets("Tabelle1").Range("C" + Trim(Str(j + 1)).Value)) ' grab the value from C4

        End If

        AlterRectangle width, "Gruppieren " + Trim(Str(k + i))

        k = k + 1

    Next i

End Sub


Private Sub AlterRectangle(width As Double, shapeName As Integer)

    Dim Nut As Shape
    Set Nut = ThisWorkbook.Sheets("Tabelle1").shapes(shapeName)
    With Nut
        .Width = width
        .Left = 400
    End With

End Sub

这使得形状G10，G14，G18和G22的宽度为C3值，G12，G16，G20和G24的宽度为C4值。

最好在形状上使名称不同，以便更容易指定哪一个需要一定的尺寸。

根据您的评论

更新：

Private Sub CommandButton1_Click()

    Dim width As Double
    Dim group1() As String, group2() As String
    Dim name As String

    group1 = Split("Gruppieren 10,Gruppieren 14,Gruppieren 18,Gruppieren 22", ",")
    group2 = Split("Gruppieren 12,Gruppieren 16,Gruppieren 20,Gruppieren 24", ",")

    For Each name In group1
        width = (Sheets("Tabelle1").Range("C3").Value) ' grab the value from C3
        AlterRectangle width, name
    Next name

    For Each name In group2
        width = (Sheets("Tabelle1").Range("C4").Value) ' grab the value from C4
        AlterRectangle width, name
    Next name

End Sub


Private Sub AlterRectangle(width As Double, shapeName As Integer)

    Dim Nut As Shape
    Set Nut = ThisWorkbook.Sheets("Tabelle1").Shapes(shapeName)
    With Nut
        .width = width
        .Left = 400
    End With

End Sub

Answer 2

以下是如何组织代码以调整形状大小的示例：

更新：这是我在没有测试的情况下编写和发布的内容。以下修改后的代码

Option Explicit

Sub CommandButton1_Click()
    Dim tabelleWB As Workbook
    Dim tabelleWS As Worksheet
    Set tabelleWB = ThisWorkbook
    Set tabelleWS = tabelleWB.Sheets("Tabelle1")

    Dim nutBreiteA As Long
    Dim nutBreiteB As Long
    nutBreiteA = tabelleWS.Range("C3")
    nutBreiteB = tabelleWS.Range("C4")

    '--- assign shapes to groups using the name of the shape
    Dim gruppierenA() As String
    Dim gruppierenB() As String
    gruppierenA = Split("Gruppieren 1,Gruppieren 2,Gruppieren 3,Gruppieren 4", ",")
    gruppierenB = Split("Gruppieren 5,Gruppieren 6,Gruppieren 7,Gruppieren 8", ",")

    SetShapeSize tabelleWS, gruppierenA, nutBreiteA
    SetShapeSize tabelleWS, gruppierenB, nutBreiteB

End Sub

Sub SetShapeSize(ws As Worksheet, shapeNames() As String, newSize As Long)
    Dim shapeName As Variant
    Dim thisShape As Shape
    For Each shapeName In shapeNames
        Set thisShape = ws.Shapes(shapeName)
        thisShape.Width = newSize
        thisShape.Left = 400
    Next shapeName
End Sub

vba Excel：多个形状的相同参数 - LIST而不是WITH

2 个答案: