以下是引用zldccmx在2008-6-22 13:15:33的发言:呵呵,受启发!使用.TopLeftCell!! Sub 将A列最后数据行以上的所有图片自动缩放到B列() Dim Pic As Picture, i&, target As Range i = [A65536].End(xlUp).Row For Each Pic In Sheet1.Pictures ' If Not Application.Intersect(Pic.TopLeftCell, Range("B1:B" & i)) Is Nothing Then Pic.ShapeRange.LockAspectRatio = msoTrue Pic.ShapeRange.Rotation = 0# Pic.Placement = xlMoveAndSize Set target = Pic.TopLeftCell If target.Column <> 2 Then Set target = Cells(target.Row, 2) nW = target.Width / Pic.Width '缩放比例 nH = target.Height / Pic.Height If nW < nH Then '以宽度为标准缩放 Pic.ShapeRange.Left = target.Left '+ (TARGET.ColumnWidth * 6.1 - .ShapeRange.Width) / 2 Pic.ShapeRange.Width = target.Width 'IncremenTARGETop (TARGET.Height - .Height * nW) / 2 Pic.ShapeRange.Top = target.Top + (target.Height - Pic.Height) / 2 Else '以高度为标准缩放 Pic.ShapeRange.Top = target.Top Pic.ShapeRange.Height = target.Height Pic.ShapeRange.Left = target.Left + (target.Width - Pic.Width) / 2 End If ' End If Next End Sub
如果不想全部都修改,而只需要对其中选定的图片进行操作,又该怎么修改代码呢? |