1

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

  1. 如果图片数量 <=6 多于 1 行图片并将尺寸设置为 h:7,25cm w:4,7cm
  2. 如果图片数量 >6 且 <=11，则 1 行图片尺寸为 h:5,9cm w:3,8cm
  3. 如果图片数量 = 12 比 2 行，尺寸从 1 点开始 h:7,25cm w:4,7cm。
  4. 如果图片数量大于 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
4

2 回答 2

2

对于倒数第二个条件，如果总图片数为 12，那么我可以安全地假设您每行需要 6 个。对于最后一个条件，您需要每行 7 个。对于这两个，我们将使用 a Counter，然后我们将为此目的做任何一个Counter Mod 6或做。您可以在 MS KBCounter Mod 7中阅读有关Mod 运算符的信息。

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

这是你正在尝试的吗？

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

截图

在此处输入图像描述

在此处输入图像描述

于 2019-02-25T14:04:56.660 回答
1
  • 如果图片数量为 6 比 1 行并将尺寸设置为 h:7,25cm w:4,7cm
  • 如果图片数量 >7 且 <=10，则 1 行图片尺寸为 h:5,9cm w:3,8cm
  • 如果图片数量小于 12，则为 2 行，大小从 1 点开始。
  • 如果图片数量大于 12，则每 7 张图片从下一行开始，大小从点 nr 2 开始

所以如果我们以i图片的数量为：

我们可以做一些简单的计算来检查满足哪个条件，并使用它Select Case 来识别和分配您的 4 个案例，如下所示：

Select Case i
    Case IS >= 12
        numberofrows = i \ 7 '(this only gives whole numbers)
        Formatting = 2
    Case IS > 10
        numberofrows = 2
        Formatting = 1
    Case IS >= 7
        numberofrows = 1
        Formatting = 2
    Case ELSE
        numberofrows = 1
        Formatting = 1
End Select
于 2019-02-25T14:03:58.300 回答