[求助]用宏实现自动调整图片大小

andy1728 · 发表于 2008-6-21 22:09

uZi3tonY.zip (5.3 KB, 下载次数: 170)
做资料需要插入大量截图，截图大小不同，请问如何用宏自动调整图片大小，让图片缩放到对应的单元格里（图片的纵横比要保持不变），请各位大侠指点！谢谢！！

山菊花 · 发表于 2008-6-21 23:21

提供三个方案，供参考。

1、点击单元格，打开文件，插入图片。

2、点击单元格，粘贴剪贴板中图像。

3、将工作表中图片统一整理。

8umsRPgW.zip (15.09 KB, 下载次数: 628)

按Alt+F11查看代码。

[此贴子已经被作者于2008-6-22 11:37:42编辑过]

andy1728 · 发表于 2008-6-22 09:07

QUOTE:

以下是引用山菊花在2008-6-21 23:21:34的发言：

用鼠标点击要添加图片的单元格。

按Alt+F11查看代码。

如果用截图软件截图后直接粘贴在表格上又怎么处理？如果需要先另存然后再插入会比较麻烦。谢谢！

山菊花 · 发表于 2008-6-22 10:33

楼上附件已更新。

zldccmx · 发表于 2008-6-22 10:59

QUOTE:

以下是引用andy1728在2008-6-22 9:07:05的发言：

如果用截图软件截图后直接粘贴在表格上又怎么处理？如果需要先另存然后再插入会比较麻烦。谢谢！

我也站在超级版主的肩膀上做了一个，正在整理打包，马上上传！

稍等！

zldccmx · 发表于 2008-6-22 11:34

mL3GnnUc.rar (17.88 KB, 下载次数: 764)

严重声明：部分代码是引用　超级版主　山菊花　的。在此对　超级版主：山菊花　表示感谢！

其实，这个题，我昨天就有开始琢磨，关键部分始终掌握不好：图片自动根据单元格的宽窄，尽量使图片占满格子，却不超出，想了许多办法，终于看到了山版的主意。

我在附件中引入了一个窗体，在窗体中来选择目标单元格，然后自动适应，让图片自动居中（上下、左右都居中），这个花了一些时间调试！所以附件上传较晚！！

zldccmx · 发表于 2008-6-22 11:37

QUOTE:

以下是引用山菊花在2008-6-22 10:33:30的发言：
楼上附件已更新。

向版主报告：

俺踩着你的肩膀了！不好意思哦，谢谢哦！

俺的作品在　7　楼，请赐教！

[此贴子已经被作者于2008-6-22 11:43:30编辑过]

zldccmx · 发表于 2008-6-22 11:42

纪念一下，俺　的　第　1818　个帖子，

而且，这个帖子是发给山菊花版主的，有意思哦！

[em24][em24][em24][em24][em24][em41][em41][em41][em38][em38][em38][em49][em49][em46]

andy1728 · 发表于 2008-6-22 12:50

QUOTE:

以下是引用zldccmx在2008-6-22 11:34:05的发言：

eHR3w66u.rar (10.99 KB, 下载次数: 249)

zldccmx · 发表于 2008-6-22 13:15

呵呵，受启发！使用.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

		自动登录	找回密码
密码			免费注册

[求助] [求助]用宏实现自动调整图片大小

回复：（andy1728）[求助]用宏实现自动调整图片大小

评分