3个回答
展开全部
下面是我自己用的一个宏,供参考。
Sub a批量调整图片大小()
Dim picture_total%
A = InputBox("固定高度:H" & Chr(10) & "固定宽度:W" & Chr(10) & "比例缩放:S", "调整图片大小", "H")
A = UCase(A)
picture_total = ActiveSheet.Shapes.Count
For i = 1 To picture_total
Select Case A
Case "H"
If i = 1 Then h = InputBox("请输入图片高度:", "提示:", "200")
ActiveSheet.Shapes(i).Height = h
If i = 1 Then c = MsgBox("是否同一水平高度?", vbOKCancel, "提示:")
' SendKeys "{TAB}"
If c = vbOK Then
If i = 1 Then t = InputBox("请输入图片上端位置:", "提示:", "200")
ActiveSheet.Shapes(i).Top = t
End If
Case "W"
If i = 1 Then w = InputBox("请输入图片宽度:", "提示:", "200")
ActiveSheet.Shapes(i).Width = w
Case "S"
If i = 1 Then s_old = ActiveSheet.Shapes(i).Height
If i = 1 Then s = InputBox("请输入缩放比例(100%):", "提示:", "100")
ActiveSheet.Shapes(i).Height = s_old * s / 100
Case Else
b = MsgBox("您输入的字符不正确!" & Chr(10) & "即将退出程序!", vbOKOnly, "警告!")
Exit Sub
End Select
Next
End Sub
Sub a批量调整图片大小()
Dim picture_total%
A = InputBox("固定高度:H" & Chr(10) & "固定宽度:W" & Chr(10) & "比例缩放:S", "调整图片大小", "H")
A = UCase(A)
picture_total = ActiveSheet.Shapes.Count
For i = 1 To picture_total
Select Case A
Case "H"
If i = 1 Then h = InputBox("请输入图片高度:", "提示:", "200")
ActiveSheet.Shapes(i).Height = h
If i = 1 Then c = MsgBox("是否同一水平高度?", vbOKCancel, "提示:")
' SendKeys "{TAB}"
If c = vbOK Then
If i = 1 Then t = InputBox("请输入图片上端位置:", "提示:", "200")
ActiveSheet.Shapes(i).Top = t
End If
Case "W"
If i = 1 Then w = InputBox("请输入图片宽度:", "提示:", "200")
ActiveSheet.Shapes(i).Width = w
Case "S"
If i = 1 Then s_old = ActiveSheet.Shapes(i).Height
If i = 1 Then s = InputBox("请输入缩放比例(100%):", "提示:", "100")
ActiveSheet.Shapes(i).Height = s_old * s / 100
Case Else
b = MsgBox("您输入的字符不正确!" & Chr(10) & "即将退出程序!", vbOKOnly, "警告!")
Exit Sub
End Select
Next
End Sub
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询
广告 您可能关注的内容 |