我尝试调整由前任同事创建的代码失败了。目前我们在下面使用此代码。它附加到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
答案 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