[已解决]更改图片的显示方式

fightingd

附件功能的是，点击指定区域单元格时，根据单元格的内容，显示指定目录下对应名称的图片。
  目前是靠右显示，能否帮忙改成在左边显示，当内容在底部时，向上显示，效果如下图：

  

                             测试附件： Pic.zip (124.66 KB, 下载次数: 50)

2012-11-15 13:14 上传

点击文件名下载附件


，

最佳答案

月排行榜 / 总排行榜

爱疯

2012-11-15 18:07

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim p$, x%
    If ActiveSheet.Pictures.Count Then ActiveSheet.Pictures.Delete
    If Target.Count <> 1 Then End
    If Target = "" Then End
    If Target.Column <> 19 Then End
    p = ThisWorkbook.Path & "\" & Target & ".jpg"
    If Dir(p) <> "" Then
        With ActiveSheet.Pictures.Insert(p)
            .Left = Target.Left - .Width
            Application.EnableEvents = False
            x = Cells.SpecialCells(xlCellTypeLastCell).Row
            Application.EnableEvents = True
            If Target.Row < x / 2 Then
                .Top = Target.Top + Target.Height
            Else
                .Top = Target.Top - .Height
            End If
        End With
    End If
End Sub

跳转到最佳答案楼层

爱疯

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim p$, x%
    If Target.Column = 19 And Target <> "" And Target.Count = 1 Then
        If ActiveSheet.Pictures.Count Then ActiveSheet.Pictures.Delete
        p = ThisWorkbook.Path & "\" & Target & ".jpg"
        If Dir(p) <> "" Then
            With ActiveSheet.Pictures.Insert(p)
                .Left = Target.Left - .Width
                Application.EnableEvents = False
                x = Cells.SpecialCells(xlCellTypeLastCell).Row
                Application.EnableEvents = True
                If Target.Row < x / 2 Then
                    .Top = Target.Top
                Else
                    .Top = Target.Top + Target.Height - .Height
                End If
            End With
        End If
    End If
End Sub

fightingd

还差一点，显示是在当前单元格所在行的下一行。
自己看看示例图片就明白了，非常感谢。

还有一点，点击非指定位置或空单元格时，应该没有图片显示才对。

爱疯

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim p$, x%
    If ActiveSheet.Pictures.Count Then ActiveSheet.Pictures.Delete
    If Target.Count <> 1 Then End
    If Target = "" Then End
    If Target.Column <> 19 Then End
    p = ThisWorkbook.Path & "\" & Target & ".jpg"
    If Dir(p) <> "" Then
        With ActiveSheet.Pictures.Insert(p)
            .Left = Target.Left - .Width
            Application.EnableEvents = False
            x = Cells.SpecialCells(xlCellTypeLastCell).Row
            Application.EnableEvents = True
            If Target.Row < x / 2 Then
                .Top = Target.Top + Target.Height
            Else
                .Top = Target.Top - .Height
            End If
        End With
    End If
End Sub

fightingd

正是想要的结果，结贴。