插入的图片现在是链接

时间:2017-05-01 18:54:36

标签: excel vba

我尝试调整由前任同事创建的代码失败了。目前我们在下面使用此代码。它附加到Excel工作表上的按钮,这会将图像插入到指定的单元格区域中,它会调整图像大小,然后落在下面的单元格上以键入描述。我们遇到的问题是我们的模板现在正从我们的服务器移动到外部位置。所以所有的图像现在都只是破碎的链接。我尝试了几个基于其他帖子的调整,但都没有成功。

Private Sub Picture1_Click()
' Select Image From File
With Application.FileDialog(msoFileDialogFilePicker)
    If .Show Then
    PicLocation = .SelectedItems(1)
    Else
    PicLocation = ""
    End If
End With

' Error Check
If PicLocation = "" Then
MsgBox "No picture selected"
    Exit Sub
End If

'Initialization
Dim TargetCells As Range

ActiveSheet.Unprotect
Set TargetCells = Range("B9:H24")

' Error check 2
If PicLocation <> "False" Then
    Set p = ActiveSheet.Pictures.Insert(PicLocation)
Else
    Exit Sub
End If

' Set image dimensions
With p.ShapeRange
    .LockAspectRatio = msoTrue
        .Height = TargetCells.Height
        If .Width > TargetCells.Width Then .Width = TargetCells.Width
End With

' Set image location
With p
    .top = TargetCells.top
    .Left = TargetCells.Left
    .PrintObject = True
End With

 ' Close out operations
Range("a25").Select

Set p = Nothing

End Sub

1 个答案:

答案 0 :(得分:0)

几年前切换Excel版本时遇到了同样的问题。我的宏现在使用.Shapes.addPicture修改了一段代码

If PicLocation <> "False" Then
    Set p = ActiveSheet.Shapes.addPicture fileName:=PicLocation, linktofile:=False, savewithdocument:=True
Else
    Exit Sub
End If