固定單元格自动显示照片

joyark

固定單元格自动显示照片

1.第一種方法
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Image1
        Select Case ActiveCell.Address(False, False)
        Case "C4"
            P = "DC.JPG"
        Case "E4"
            P = "FG.JPG"
        Case "K5"
            P = "PR.JPG"
        Case Else
            .Visible = False
            Exit Sub
        End Select
        .Picture = LoadPicture(ThisWorkbook.Path & "\pic\" & P)
        .Visible = True
    End With
    With ActiveCell
        Image1.Top = .Top - Image1.Height / 2
        Image1.Left = .Left + .Width
    End With
End Sub
2.第二種方法

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 1 Then Exit Sub    '如果需要只在第一列输入才产生效果 , 就在代码开头插入一句
'If Target.Count <> 1 Then Exit Sub'全部输入才产生效果 , 就在代码开头插入一句
    Dim sPh As String
    On Error Resume Next
    sPh = ThisWorkbook.Path & "\pic\" & Target.Text & ".jpg"
    Target.Comment.Delete
    With Target.AddComment
        .Visible = True
        .Text Text:=""
        .Shape.Select True
        If Len(Dir(sPh)) Then
            With Selection.ShapeRange
                .Fill.UserPicture ThisWorkbook.Path & "\pic\" & Target.Text & ".jpg"
                .ScaleWidth 1.7, msoFalse, msoScaleFromTopLeft
                .ScaleHeight 2, msoFalse, msoScaleFromTopLeft
            End With
        Else
            .Text Text:="找不到指定的图片"
        End If
    End With
    Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End Sub

3.第三種方法
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count <> 1 Then Exit Sub
    Dim sPh As String
    Dim oCm As Comment
    Set oCm = Target.Comment
    sPh = ThisWorkbook.Path & "\pic\" & Target.Text & ".jpg"
    If Not oCm Is Nothing Then
        If Len(oCm.Text) = 0 Or Len(Dir(sPh)) Then oCm.Delete
    End If
    If Len(Dir(sPh)) Then
        With Target.AddComment
            .Visible = True
            .Text Text:=""
            .Shape.Select True
        End With
        With Selection.ShapeRange
            .Fill.UserPicture ThisWorkbook.Path & "\pic\" & Target.Text & ".jpg"
            .ScaleWidth 1.7, msoFalse, msoScaleFromTopLeft
            .ScaleHeight 4, msoFalse, msoScaleFromTopLeft
        End With
        Application.DisplayCommentIndicator = xlCommentIndicatorOnly
    End If
End Sub

tmtony

赞一个