如何批量改变图片大小

najagay

正在做一个学校30年大册子，遇到几个技术问题朋友们能否帮个忙，给点力量
1、里面有很多老师的简介，每个简介旁边还要贴每个老师的照片，因为老师的照片有的是2寸、有的是5寸，扫描后图片的大小不一样，把照片已经都插入到各自简介旁了，现在又要求所有的照片的大小必须一样，450多个照片，手工改变大小可能性不大，有没有简便的办法？
2、页码要放在外此的中间（不是书的下方，而是左侧），外面还要有图案（圆圈图案），也就是说页码在这个图案里，这个怎么做？

lpzxhjp

上个附件......

黑夜(刚子)

改变图片尺寸运行以下宏
Public Sub 改变图片尺寸()
Dim i As Shape
    For Each i In ActiveSheet.Shapes
    i.Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Height = 50  '' 高度 [尺寸自己可变更]
    Selection.ShapeRange.Width = 50   '' 宽度 [尺寸自己可变更]
    Selection.ShapeRange.Rotation = 0#  ‘’旋转角度
    Next
End Sub

najagay

谢谢您的回复，你的这个代码是在Excel中的代码，我要的是Word中的代码

房振宇rain

好，不错，试试看

szqhb

Sub 图片统一大小()
On Error Resume Next
Dim mywidth
Dim myheight
Application.ScreenUpdating = False '关闭屏幕更新
mywidth = Val(InputBox(Prompt:="单位为厘米(cm);如果输入为0，则图片保持原始纵横比,宽度根据输入的高度数值自动调整；", Title:="请输入图片宽度", Default:="0")) * 28.35
myheight = Val(InputBox(Prompt:="单位为厘米(cm);如果输入为0，则图片保持原始纵横比,高度根据输入的宽度数值自动调整；", Title:="请输入图片高度", Default:="0")) * 28.35
'------------------------------------------------------------------
'调整嵌入式图形
Dim pic As InlineShape
For Each pic In ActiveDocument.InlineShapes
If mywidth = "0" Then
pic.Height = myheight
pic.ScaleWidth = pic.ScaleHeight
ElseIf myheight = "0" Then
pic.Width = mywidth
pic.ScaleHeight = pic.ScaleWidth
Else
pic.Width = mywidth
pic.Height = myheight
End If
Next
'调整浮动式图形
Dim tu As Shape
For Each tu In ActiveDocument.Shapes
If mywidth = "0" Then
tu.Height = myheight
ElseIf myheight = "0" Then
tu.Width = mywidth
Else
tu.LockAspectRatio = msoFalse
tu.Width = mywidth
tu.Height = myheight
End If
Next
  Application.ScreenUpdating = True '恢复屏幕更新
End Sub

tangqingfu

谢谢sqzhb兄的分享！

najagay

谢谢sqzhb兄的分享！要的就是这个,万分的感谢！

wsk0722

谢谢达人的解释，这个太有用了

li02

Sub 图片宽度大小()
    On Error Resume Next
    Dim mywidth
    Application.ScreenUpdating = False    '关闭屏幕更新
    mywidth = Val(InputBox(Prompt:="单位为厘米(cm);如果输入为0，则图片保持原始纵横比,宽度根据输入的高度数值自动调整；", Title:="请输入图片宽度", Default:="0")) * 28.35
    '调整嵌入式图形
    Dim pic As InlineShape
    For Each pic In ActiveDocument.InlineShapes
        If pic.Width > 200 Then
            pic.ScaleHeight = 100
            pic.ScaleWidth = 100
            pic.Width = mywidth
            pic.LockAspectRatio = msoTrue
        End If
    Next
    Application.ScreenUpdating = True    '恢复屏幕更新
End Sub

学习着写了个改宽度的，谢谢！