excel - 在工作表中定位图片

Question

下面的代码计数将(由其他宏)粘贴为 excel 工作表中的 msorectangle 形状的图片，并将它们放置在每行之间特定距离的 1 行中。我需要为定位添加另一个限制，并且我正在努力编码它。问题是在以下情况下如何升级此代码:

如果图片数量 <=6 多于 1 行图片并将尺寸设置为 h:7,25cm w:4,7cm

如果图片数量 >6 且 <=11，则 1 行图片尺寸为 h:5,9cm w:3,8cm

如果图片数量 = 12 比 2 行，尺寸从 1 点开始 h:7,25cm w:4,7cm。

如果图片数量大于 12，则每(7、13、19、25 等图片)从下一行开始，大小从点 nr 2 h:5,9cm w:3,8cm

开始

图片列表是动态的。

Sub Sample2()
Dim shp As Shape, shp2 As Shape
Dim ws As Worksheet
Dim lstShp As Integer
Dim shpLft As Double, shpTop As Double, shpWidth As Double, shpHeight As Double
Dim inBetweenMargin As Double
Dim i As Long

    '~~> In betwen margin
    inBetweenMargin = 8 


    Set ws = ThisWorkbook.Worksheets("wk")

    With ws
        '~~> Get the max shape number(name)
        For Each shp In .Shapes
            If shp.AutoShapeType = msoShapeRectangle Then
                If Val(shp.Name) > 1 And Val(shp.Name) > lstShp Then _
                lstShp = Val(shp.Name)
            End If
        Next

        '~~> Loop through the shapes
        For i = 1 To lstShp
            '~~> This is required in case you delete shape 3
            '~~> and have only shapes 1,2,4,5 etc...
            On Error Resume Next
            Set shp = .Shapes(CStr(i))
            'shp2 = first photo
            Set shp2 = ws.Shapes("1")
            On Error GoTo 0

            '~~> position them
            If Not shp Is Nothing And shp.AutoShapeType = msoShapeRectangle Then
                If shpLft = 0 And shpTop = 0 And shpWidth = 0 Then
                    shpLft = shp.Left
                    shpTop = shp.Top
                    shpWidth = shp.Width
                Else

                    shp.Top = shpTop
                    shp.Left = shpLft + shpWidth + inBetweenMargin

                    shpLft = shp.Left
                    shpWidth = shp.Width
                End If
            End If

         'position picture nr 7 and above in second row
        If Val(shp.Name) = 7 Then
            shp.Top = shp2.Top + shp2.Height + inBetweenMargin
            shp.Left = shp2.Left

            shpLft = shp.Left
            shpWidth = shp.Width
        End If

        If Val(shp.Name) >= 8 Then
            shp.Top = shp2.Top + shp2.Height + inBetweenMargin
        End If

        Next i
    End With
End Sub

Answer 1

对于倒数第二个条件，如果总图片数为 12，那么我可以安全地假设您每行需要 6 个。对于最后一个条件，您需要每行 7 个。对于这两个，我们将使用 Counter然后我们会做Counter Mod 6或 Counter Mod 7为了这个目的。您可以阅读 Mod operator以 MS KB 为单位。

逻辑是重置.Top和 .Left在最后两个条件的下一行中。我们将为此使用一个 bool 变量。

这是你正在尝试的吗？

Option Explicit

Sub Sample()
    Dim shp As Shape, shp2 As Shape
    Dim ws As Worksheet
    Dim lstShp As Integer
    Dim shpLft As Single, shpTop As Single, shpWidth As Single, shpHeight As Single
    Dim oldLeft As Single, oldTop As Single
    Dim inBetweenMargin As Single
    Dim i As Long, counter As Long, picCount As Long
    Dim nextLine As Boolean, MultipleRows As Boolean
    Dim ModByNumber As Long

    '~~> In betwen margin
    inBetweenMargin = 8

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With ws
        '~~> Get the max shape number(name)
        For Each shp In .Shapes
            If shp.AutoShapeType = msoShapeRectangle Then
                If Val(shp.Name) > 1 And Val(shp.Name) > lstShp Then _
                lstShp = Val(shp.Name)
                picCount = picCount + 1
            End If
        Next

        Select Case picCount
            Case 1 To 6
                '~~> Set your default height and Width
                shpHeight = 7.25 * 28.34646 '<~~ Cm to Points
                shpWidth = 4.7 * 28.34646 '<~~ Cm to Points
            Case 7 To 11
                '~~> Set your default height and Width
                shpHeight = 5.9 * 28.34646 '<~~ Cm to Points
                shpWidth = 3.8 * 28.34646 '<~~ Cm to Points
            Case 12
                '~~> Set your default height and Width
                shpHeight = 7.25 * 28.34646 '<~~ Cm to Points
                shpWidth = 4.7 * 28.34646 '<~~ Cm to Points
                MultipleRows = True
                ModByNumber = 6
            Case Is > 12
                '~~> Set your default height and Width
                shpHeight = 5.9 * 28.34646 '<~~ Cm to Points
                shpWidth = 3.8 * 28.34646 '<~~ Cm to Points
                MultipleRows = True
                ModByNumber = 7
        End Select

        nextLine = False

        '~~> Loop through the shapes
        For i = 1 To lstShp
            '~~> This is required in case you delete shape 3
            '~~> and have only shapes 1,2,4,5 etc...
            On Error Resume Next
            Set shp = .Shapes(CStr(i))
            On Error GoTo 0

            '~~> position them
            If Not shp Is Nothing Then
                If shp.AutoShapeType = msoShapeRectangle Then
                    If shpLft = 0 And shpTop = 0 Then
                        shpLft = shp.Left
                        shpTop = shp.Top
                        shp.Height = shpHeight
                        shp.Width = shpWidth

                        '~~> Storing the top and left for resetting
                        '~~> when moving to next line
                        oldTop = shp.Top
                        oldLeft = shp.Left

                        counter = counter + 1
                    Else
                        shp.Top = shpTop
                        oldTop = shpTop

                        If nextLine = True Then
                            shp.Left = shpLft
                            nextLine = False
                            counter = 1
                        Else
                            shp.Left = shpLft + shpWidth + inBetweenMargin
                            counter = counter + 1
                        End If

                        shp.Height = shpHeight
                        shp.Width = shpWidth

                        shpLft = shp.Left

                        If MultipleRows = True Then
                            If counter Mod ModByNumber = 0 Then
                                shpLft = oldLeft
                                shpTop = oldTop + shpHeight + inBetweenMargin
                                nextLine = True
                            End If
                        End If
                    End If
                End If
            End If

            '~~> This is required if there is no shape between 4 and 6.
            '~~> 5 gets deleted? Also the reason why we are not using "i Mod 7"
            '~~> and using "counter Mod 7"
            Set shp = Nothing
        Next i
    End With
End Sub

截图