Question

我研究过网络但无法找到有助于我的解决方案。

我有一张Excel工作表并创建了一个具有InkPicture Box的UserForm，并设置为允许某人打开用户表单并绘制他们的签名。分配了一个CommandButton来获取签名并将其从剪贴板保存到PC上。我有另一个CommandButton分配从PC路径检索所保存的图片，并将其带回我的工作簿中的特定工作表，并将其插入特定的单元格。

我的需求如下：我需要使用代码来更新每次单击按钮时插入图像的单元格。（换句话说。每当我按下按钮并且在它恢复到C3之后，我需要代码从C3增加到C50，增加一个数字）

可以这样做吗？

此代码将图像带回我的工作表，但每次单击CommandButton时，图像都会插入到C3中（因此所有图像都在彼此之上而不是彼此之下）：

Private Sub CommandButton4_Click()

Dim ws As Worksheet
Dim ImgPath As String
Dim W As Double, H As Double
Dim L As Long, T As Long

Set ws = ThisWorkbook.Sheets("Mobile POS Log Sheet")

'~~> This is my current pic file path
ImgPath = "C:\Users\raphaelo\Downloads\test.gif"

With ws
    W = 30                  '<~~ Width
    H = 11                  '<~~ Height
    L = .Range("c3").Left   '<~~ This is what should be changing each time I run the command
    T = .Range("c3").Top    '<~~ This is what should be changing each time I run the command
     '<~~ Both the L and T Range entries should change to the next cell (C3 to C4 to C5 and so on) One digit up every time I run the Command Code
     '<~~ Unless it's the Placement entry below?
    With .Pictures.Insert(ImgPath)
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Width = W
            .Height = H
        End With
        .Left = L
        .Top = T
        .Placement = 1 '<~~ Not sure if this is the one that should change one digit up each time I run the Command instead?
    End With
End With

请指导我正确的方向！什么是自动重新计算自己的代码，以便在每次运行时将输出分配给列中的不同单元格？

Answer 1

我一定误解了你的问题。而不是＆＃34;最后使用的行＆＃34;您需要找到列中的最后一行＆＃34; C＆＃34;它有一个形状。此更改的代码将在列C中找到具有形状的最后一行，然后它将向该数字添加2行，然后将图像放在最下面的行下面两行。您可以将这些行更改为您需要的许多行。如果在运行此工作表时表单上没有形状，则可能会出错。如果是这样，那么你将不得不为此创建一个错误捕获。

Private Sub CommandButton4_Click()

Dim ws As Worksheet
Dim ImgPath As String
Dim W As Double, H As Double
Dim L As Long, T As Long
Dim myArr() As Variant, myArrCounter As Long
Dim newRowNumb As Long

Set ws = ThisWorkbook.Sheets("Mobile POS Log Sheet")

'////////////////////////////////////////   This section will find the row of the bottom most shape in Column C
ReDim myArr(1 To 1)
myArrCounter = 0

For Each wshape In ws.Shapes
    myArrCounter = myArrCounter + 1
    If myArrCounter = 1 And wshape.TopLeftCell.Column = 3 Then
        myArr(myArrCounter) = wshape.TopLeftCell.row
    Else:
        If wshape.TopLeftCell.Column = 3 And wshape.TopLeftCell.row > myArr(UBound(myArr)) Then
            ReDim Preserve myArr(1 To myArrCounter)
            myArr(myArrCounter) = wshape.TopLeftCell.row
        End If
    End If
Next wshape
newRowNumb = myArr(UBound(myArr)) + 2 ' this adds two rows to place the new picure.  Change the "2" to how many rows you need



'~~> This is my current pic file path
ImgPath = "C:\Users\raphaelo\Downloads\test.gif"


    With ws
        W = 30                  '<~~ Width
        H = 11                  '<~~ Height
        L = .Range("c" & newRowNumb).Left   '<~~ This is what should be changing each time I run the command
        T = .Range("c" & newRowNumb).Top    '<~~ This is what should be changing each time I run the command
         '<~~ Both the L and T Range entries should change to the next cell (C3 to C4 to C5 and so on) One digit up every time I run the Command Code
         '<~~ Unless it's the Placement entry below?
        With .Pictures.Insert(ImgPath)
            With .ShapeRange
                .LockAspectRatio = msoTrue
                .Width = W
                .Height = H
            End With
            .Left = L
            .Top = T
            .Placement = 1 '<~~ Not sure if this is the one that should change one digit up each time I run the Command instead?
        End With
    End With

End Sub

每次我在Excel

1 个答案: