Question

我在stock.xlsm工作簿中有一个库存工作表，其中包含许多产品图片。我使用名为AddPicFromFile()的宏从桌面添加图片并将其放入单元格中。我要求在运行宏时，它会执行其通常的工作，还要为图片形状分配一个名为ClickResizeImage（）的宏。

Sub AddPicFromFile()

Dim ws As Worksheet
Dim imagePath As String
Dim imgLeft As Double
Dim imgTop As Double

Set ws = ActiveSheet
imagePath = "C:\Users\Secret\Desktop\untitled-1.jpg"
imgLeft = ActiveCell.Left
imgTop = ActiveCell.Top

'Width & Height = -1 means keep original size
ws.Shapes.AddPicture _
    Filename:=imagePath, _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, _
    Left:=imgLeft + 0.75, _
    Top:=imgTop + 0.75, _
    Width:=42, _
    Height:=42

End Sub

这是ClickResizeImage（），它作为独立版本当然可以很好地工作。

Sub ClickResizeImage()
Dim shp As Shape
    Dim big As Single, small As Single

    Dim shpDouH As Double, shpDouOriH As Double
    big = 8
    small = 1
    On Error Resume Next
    Set shp = ActiveSheet.Shapes(Application.Caller)
    With shp
        shpDouH = .Height
        .ScaleHeight 1, msoTrue, msoScaleFromTopLeft
        shpDouOriH = .Height

        If Round(shpDouH / shpDouOriH, 2) = big Then
            .ScaleHeight small, msoTrue, msoScaleFromTopLeft
            .ScaleWidth small, msoTrue, msoScaleFromTopLeft
            .ZOrder msoSendToBack
        Else
            .ScaleHeight big, msoTrue, msoScaleFromTopLeft
            .ScaleWidth big, msoTrue, msoScaleFromTopLeft
            .ZOrder msoBringToFront
        End If
    End With

End Sub

我尝试将Selection.OnAction = "ClickResizeImage"添加到代码中，但是它出现运行时错误'438'：对象不支持此属性或方法。问题的一部分是AddPicFromFile不选择形状，而ClickResizeImage则需要它才能工作，因为它确实可以作为独立模块工作。我只想将它们基本上合并为一个宏。

Answer 1

这会将宏分配给Shape：

Sub stepup()
    Dim s As Shape
    Set s = ActiveSheet.Shapes(1)
    s.OnAction = "ClickResizeImage"
End Sub

Answer 2

将此代码添加到您的std::sort代码的末尾：

AddPicFromFile

以编程方式将Excel中的宏分配给从文件

2 个答案: