[已解决][讨论]图片引用

c888

图片引用.rar (776.23 KB, 下载次数: 46)

2011-3-9 15:59 上传

点击文件名下载附件
     弄了半天，终于将单元格中的图片引用到了图片框上了。
     但现在有个问题还需请高手解决。就是工作表锁定后，图片就无法引用了！

最佳答案

月排行榜 / 总排行榜

zzk386

2011-3-9 20:53

Sub ad()
    Dim pth As String
    Dim pthname As String
    Dim rng1 As Range
    Dim rng2 As Range
    On Error Resume Next
    pth = ThisWorkbook.Path & "\" & "图片库\"
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect '解除工作表保护
    With Sheet1
        Set rng1 = .Cells(2, 6)
        If Len(rng1.Text) Then
            Set rng2 = .Cells(8, 6)
            .Pictures(rng2.Address(0, 0)).Delete
            pthname = Dir(pth & rng1.Text & "*")
            With ActiveSheet.Pictures.Insert(pth & pthname)
                .Name = rng2.Address(0, 0)
                .Height = rng2.Height
                .Top = rng2.Top
                .Left = rng2.Left
                .Width = rng2.Width
            End With
         End If
    End With
    ActiveSheet.Protect '保护工作表
    Application.ScreenUpdating = True
End Sub

跳转到最佳答案楼层

zzk386

在代码的前面加上解除工作表的代码,在代码结束的地方再加上锁定工作表的代码.

zzk386

Sub ad()
    Dim pth As String
    Dim pthname As String
    Dim rng1 As Range
    Dim rng2 As Range
    On Error Resume Next
    pth = ThisWorkbook.Path & "\" & "图片库\"
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect '解除工作表保护
    With Sheet1
        Set rng1 = .Cells(2, 6)
        If Len(rng1.Text) Then
            Set rng2 = .Cells(8, 6)
            .Pictures(rng2.Address(0, 0)).Delete
            pthname = Dir(pth & rng1.Text & "*")
            With ActiveSheet.Pictures.Insert(pth & pthname)
                .Name = rng2.Address(0, 0)
                .Height = rng2.Height
                .Top = rng2.Top
                .Left = rng2.Left
                .Width = rng2.Width
            End With
         End If
    End With
    ActiveSheet.Protect '保护工作表
    Application.ScreenUpdating = True
End Sub