Question

我有一个宏，可以在表单上插入 Image 控件。
单击这些控件后，要求用户使用GetOpenFileName对话框选择图像文件。所选的图像被加载到控件中，并且文件路径被添加到B的列Sheet2上。
再次单击 Image 控件时，所选图像将以第二种形式加载到 Image 控件并显示。

如何向每个图像控件添加或附加所需的代码，以使 Click 事件起作用？

我到目前为止的代码如下：

Sub macroA1()

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

Set miesto = Sheets("Sheet2").Range("B2")
strfilename = Sheets("Sheet2").Range("B2").Value
If strfilename = "" Then
strfilename = Application.GetOpenFilename(filefilter:="Tiff     Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", FilterIndex:=2, Title:="Select a File", MultiSelect:=False)
Sheets("Sheet2").Range("B2").Value = strfilename
ElseIf strfilename = "False" Then
strfilename = Application.GetOpenFilename(filefilter:="Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", FilterIndex:=2, Title:="Select a File", MultiSelect:=False)
Sheets("Sheet2").Range("B2").Value = strfilename
Else
Sheets("Sheet2").Range("B2").Value = strfilename
End If

On Error Resume Next
UserForm1.Image1.Picture = LoadPicture(strfilename)

If strfilename = "False" Then
MsgBox "File Not Selected!"
Exit Sub
Else
End If

UserForm1.Image1.PictureSizeMode = fmPictureSizeModeStretch
UserForm1.Show

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True


End Sub

Answer 1

用户表单上的每个图片控件都需要一个click事件。该单个事件存储在 class 模块中，并附加到表单上的每个 Image 控件。

插入一个类模块，将其命名为clsLoadImage并将下面的代码添加到其中。

Public WithEvents Img As MSForms.Image 'Place at very top of module (after Option Explicit though).

Private Sub Img_Click()

    Dim FullPath As String

    With Img
        'Only load the picture if the control is empty.
        If .Picture Is Nothing Then

            'Get the file path for the image.
            FullPath = Application.GetOpenFilename

            If Len(Dir(FullPath)) = 0 Then
                MsgBox "No file find.", vbOKOnly + vbCritical
            Else
                .Tag = FullPath 'The Tag property can store extra info such as a text string.

                'Store the path in last row of Sheet2 column B.
                ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Offset(1) = FullPath

                .Picture = LoadPicture(FullPath)
                .PictureSizeMode = fmPictureSizeModeStretch
                .Parent.Repaint
            End If
        Else

            'If the image control isn't empty load the image
            'into UserForm2 using the file path stored in
            'the Tag property.

            Load UserForm2
            With UserForm2
                With .Image1
                    .Picture = LoadPicture(Img.Tag)
                    .PictureSizeMode = fmPictureSizeModeStretch
                    .Parent.Repaint
                End With
                .Show
            End With

        End If
    End With

End Sub

下一步，向项目添加UserForm。在示例代码中，我将其命名为UserForm1。使Height至少为340且相当宽。
在顶部附近添加一个CommandButton，在底部附近添加一个Image控件（我将Top放在218作为图像控件）。
这些控件可能不会包含在最终解决方案中，但是会根据您的要求提供不同的选项。
将以下代码添加到UserForm1。
打开表单时，此代码将触发。
- 代码的顶部会将Click事件附加到任何现有的 Image 控件-例如位于底部附近的控件。
- 代码的底部将为Sheet2列B中列出的每个文件路径创建一个 Image 控件，并将Click事件附加到该控件。
  注意：Top设置为134，将它们放置在表单的中间区域。

Public ImageControls As New Collection 'Place at very top of module (after Option Explicit though).

'Could execute when the form opens.
'''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub UserForm_Initialize()

    'Relies on image controls added at design time.
    'Attaches the click event to each image control.

    Dim Ctrl As Control
    Set ImageControls = New Collection
    Dim ImgEvent As clsLoadImage

    For Each Ctrl In Me.Controls
        If TypeName(Ctrl) = "Image" Then
            Set ImgEvent = New clsLoadImage
            Set ImgEvent.Img = Ctrl
            ImageControls.Add ImgEvent
        End If
    Next Ctrl

    ''''''''''''''''''''''''''''''''''''''''''''

    'Creates an image control for each file path
    'in Sheet2 column B, loads the picture,
    'stores the path in the tag property,
    'attaches the click event.

    Dim x As Long
    Dim tmpCtrl As Control

    For x = 2 To ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row

        'Add the control, name it and position it.
        Set tmpCtrl = Me.Controls.Add("Forms.Image.1", "AddedInLoop_Image_" & x)
        With tmpCtrl
            .Left = .Width * (x - 2)
            .Top = 134
            .Picture = LoadPicture(ThisWorkbook.Worksheets("Sheet2").Cells(x, 2))
            .PictureSizeMode = fmPictureSizeModeStretch
            .Tag = ThisWorkbook.Worksheets("Sheet2").Cells(x, 2)
        End With

        'Attach the Click event to the control.
        Set ImgEvent = New clsLoadImage
        Set ImgEvent.Img = tmpCtrl
        ImageControls.Add ImgEvent

    Next x
    Me.Repaint

End Sub

也将此代码添加到UserForm1中，以处理您添加的CommandButton。
每次您按下按钮时，都会添加一个 Image 控件。
注意-Top设置为40，因此它们将显示在表单顶部附近。

'Creates an image control and attaches
'a Click event to the control.
Private Sub CommandButton1_Click()

    Dim CtrlCount As Long
    Dim Ctrl As Control
    Dim tmpCtrl As Control
    Dim ImgEvent As clsLoadImage

    'Count the Image controls so each
    'new control has a unique name.
    CtrlCount = 1
    For Each Ctrl In Me.Controls
        'NB: The InStr command is only needed so the controls
        '    added in the Initalise event aren't counted.
        If TypeName(Ctrl) = "Image" And InStr(Ctrl.Name, "BtnClck_Image_") > 0 Then
            CtrlCount = CtrlCount + 1
        End If
    Next Ctrl

    'Add the control, name it and position it.
    Set tmpCtrl = Me.Controls.Add("Forms.Image.1", "BtnClck_Image_" & CtrlCount)
    With tmpCtrl
        .Left = .Width * (CtrlCount - 1)
        .Top = 40
    End With

    'Attach the Click event to the control.
    Set ImgEvent = New clsLoadImage
    Set ImgEvent.Img = tmpCtrl
    ImageControls.Add ImgEvent

End Sub

最后，添加第二个UserForm并添加一个名为Image1的 Image 控件来填充表单。我已经离开了名为UserForm2的表格。

要使用：

打开UserForm1。
- 将为B的列Sheet2中列出的每个完整文件路径和名称创建一个 Image 控件。它将显示文件路径中的图片。
- 按下按钮将创建一个空白的 Image 控件。
- 单击空白的 Image 控件将打开一个对话框，要求您选择文件。所选文件将被加载到控件中，文件路径被添加到B上的列Sheet2上。
- 单击包含图片的 Image 控件将打开UserForm2，并将图像加载到该表单的 Image 控件中。

VBA创建可创建新宏的宏

1 个答案: