Question

我在将InsertPicture代码集成到FitPicture宏时遇到问题。我很困惑如何在使用Insert函数后让形状自动调整大小。它给了我关于对象的错误。这是a link我研究的想法，但仍然无法发生任何事情。任何帮助表示赞赏。感谢。

这是我用来将图片放入合并单元格或单个单元格的宏：

Sub FitPicture()
On Error GoTo NOT_SHAPE
Dim r As Range, sel As Shape
Set sel = ActiveSheet.Shapes(Selection.Name)
sel.LockAspectRatio = msoTrue
Set r = Range(sel.TopLeftCell.MergeArea.Address)

Select Case (r.Width / r.Height) / (sel.Width / sel.Height)
Case Is > 1
    sel.Height = r.Height * 0.9
Case Else
    sel.Width = r.Width * 0.9
End Select


sel.Top = r.Top + 0.05 * sel.Height: sel.Left = r.Left + 0.05 * sel.Width

Exit Sub
NOT_SHAPE:
MsgBox "Please select a picture first."
End Sub

这是我用来插入图片的宏：

Sub InsertPicture()
Dim sPicture As String, pic As Picture

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")

If sPicture = "False" Then Exit Sub

Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic
.ShapeRange.LockAspectRatio = msoFalse
.Height = ActiveCell.Height
.Width = ActiveCell.Width
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Placement = xlMoveAndSize
End With

Set pic = Nothing

End Sub

如何将FitPicture代码集成到InsertPicture代码中？我需要在FitPicture上使用我提到的修改后自动调整大小。顺便说一句，我正在使用excel 2013.感谢伙伴。

Answer 1

经过一天的尝试，我完成了宏。处理单个单元格，合并单元格或选定单元格甚至未合并。

Sub Insert()

Dim myPicture As String, MyRange As Range
myPicture = Application.GetOpenFilename _
("Pictures (.bmp; .gif; .jpg; .png; .tif),.bmp; .gif; .jpg; .png; .tif", _
, "Select Picture to Import")

Set MyRange = Selection
InsertAndSizePic MyRange, myPicture
End Sub


Sub InsertAndSizePic(Target As Range, PicPath As String)

Dim p As Picture
Application.ScreenUpdating = False

On Error GoTo EndOfSubroutine:
Set p = ActiveSheet.Pictures.Insert(PicPath)

'resize
Select Case (Target.Width / Target.Height) / (p.Width / p.Height)
Case Is > 1
p.Height = Target.Height * 0.9
Case Else
p.Width = Target.Width * 0.9
End Select

'center picture
p.Top = Target.Top + (Target.Height - p.Height) / 2: p.Left = Target.Left + 
(Target.Width - p.Width) / 2

Exit Sub

EndOfSubroutine:
End Sub

使用宏vba插入图片以采用合并的单元格或单个单元格

1 个答案: