Question

我是Excel VBA的初学者。我有vba形式的图像控件。从文件夹中选择显示图像。我想要的是插入并保存相同的图像到单元格D.这是代码

Private Sub btnSave_Click()
    Dim irow As Long
    Dim ws As Worksheet
    Dim PictDir As String, PictType As String
    Dim SNo As Long
    Dim Image As Object
    Set ws = Worksheets("SafetyReport")
    SNo = ws.Range("A1", ws.Range("A1").End(xlDown)).Rows.Count

    If SNo = 1048576 Then
       SNo = 1
    End If


    irow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    With ws
     .Range("D" & irow) = Me.Image.Picture
End Sub

Private Sub Image_Click()
    Dim PictFileName As String
    Dim PicPath As String
    PictFileName = Application.GetOpenFilename
    PicPath = PictFileName

    If Len(Dir(PicPath)) = 0 Then
        MsgBox PicPath & " does not exist."
    Else
        Me.Image.Picture = LoadPicture(PicPath)
        Me.Repaint
    End If
End Sub

Answer 1

假设＆＃34; Image1＆＃34;是UserForm中Image控件的名称，并专注于您需要完成的特定任务，那么您可能需要考虑以下代码

Option Explicit

Private Sub btnSave_Click()
    Dim myCell As Range

    With Worksheets("SafetyReport")
        Set myCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
        If Me.Tag <> "" Then ' if any path has been stored in userform 'Tag' property
            With .Pictures.Insert(Me.Tag)
                With .ShapeRange
                    .LockAspectRatio = msoTrue
                    .Width = myCell.Width
                    .Height = myCell.Height
                End With
                .Left = myCell.Left
                .Top = myCell.Top
                .Placement = 1
            End With
            Me.Tag = "" ' clear 'Tag' property for subsequent uses
        End If
    End With
End Sub

Private Sub Image1_Click()
    Dim PicPath As Variant

    PicPath = Application.GetOpenFilename
    If PicPath = False Then
        MsgBox "No files selected"
    Else
        Me.Image1.Picture = LoadPicture(PicPath)
        Me.Repaint
        Me.Tag = PicPath ' store the picture path in Userform 'Tag' property
    End If
End Sub

使用VBA将图像从Image控件插入到带有链接的图标中

1 个答案: