wordshaperange

一、Excel shapes与shaperange区别

由 Shape 对象组成的集合，这些对象代表文档中或者文档页眉和页脚中的所有图形。每个 Shape 对象代表图形层中的一个对象，诸如自选图形、任意多边形、OLE 对象或图片等。

注意 如果需要处理文档图形的一个子集（例如只处理文档中的自选图形或仅处理选定的图形），就必须创建一个 ShapeRange 集合，以用该集合包含需要处理的图形。该集合代表所选内容或区域中的所有 Shape 对象

在WORD中，可以这样使用：

新增一个图片对象（图片是图形的一种）：

Set MyPicture = .Shapes.AddPicture(FileName:=strBmp, _Left:=SLT, Top:=STP, Width:=PW, Height:=PH)

新增一个文本框对象

Set MyText = .Shapes.AddTextbox(msoTextOrientationHorizontal, SLT, STP + PH, PW, 25)

Private Sub App_WindowSelectionChange(ByVal Sel As Selection)

Dim SelShape As Shape, W As Single, H As Single, Hp As Single, Ht As Single

On Error Resume Next

'判断光标所在位置或者选中的类型是否为图形

If Selection.Type = wdSelectionShape Then

'如果是图片并且选中的图片项目只有一个（注意可以用shapgerange(item)返回选中的图形（图片）项目

If Sel.ShapeRange.Type = 6 And Sel.ShapeRange.Count = 1 Then

Set SelShape = Sel.ShapeRange(1)

'以下可以对该selshape对象进行设置

http://club.excelhome.net/thread-251648-1-1.html

图形对象攻略指引

经常有朋友抱怨图形对象不好用，太少的参考代码，摆脱不掉的Selection、看不见成员列表，繁琐的代码输入、组合……，本文将围饶图形对象的使用一一给出这些问题的解决策略。

二、关于在WORD里使用宏将所有图片比例缩小的问题

Sub a()

i = InputBox（"请输入放大缩小比例，例如：0.5或者1.5"）

For Each pic In ActiveSheet.DrawingObjects

With pic

.Select

.ShapeRange.Height = Selection.ShapeRange.Height * i

.ShapeRange.Width = Selection.ShapeRange.Width * i

End With

Next

End Sub

试试 这样吧 有问题在沟通

三、VB 如何控制WORD中插入图片的大小等属性

自己录个宏，稍加改动就可以了。

Sub 图片旋转270度对齐页面（）'图片排版270度 If Selection.InlineShapes.Count = 0 Then If Selection.ShapeRange.Count <> 0 Then Selection.ShapeRange.Fill.Visible = msoFalse 'Selection.ShapeRange.AlternativeText = "Higer标书工具修改" Selection.ShapeRange.Fill.Solid Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoFalse Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Rotation = 270# Selection.ShapeRange.Width = CentimetersToPoints(28.9) Selection.ShapeRange.Height = CentimetersToPoints(20.2) 'Selection.ShapeRange.PictureFormat.Brightness = 0.5 'Selection.ShapeRange.PictureFormat.Contrast = 0.5 'Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic Selection.ShapeRange.PictureFormat.CropLeft = 0# Selection.ShapeRange.PictureFormat.CropRight = 0# Selection.ShapeRange.PictureFormat.CropTop = 0# Selection.ShapeRange.PictureFormat.CropBottom = 0# 'Selection.ShapeRange.Left = 90.1 'Selection.ShapeRange.Top = 88.15 'Selection.ShapeRange.Left = -120.45 'Selection.ShapeRange.Top = 109.1 Selection.ShapeRange.RelativeHorizontalPosition = _ wdRelativeHorizontalPositionPage Selection.ShapeRange.RelativeVerticalPosition = _ wdRelativeVerticalPositionPage Selection.ShapeRange.Left = wdShapeCenter Selection.ShapeRange.Top = wdShapeCenter Selection.ShapeRange.LockAnchor = False Selection.ShapeRange.LayoutInCell = True Selection.ShapeRange.WrapFormat.AllowOverlap = True Selection.ShapeRange.WrapFormat.Side = wdWrapBoth Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0) Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0) Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32) Selection.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0.32) Selection.ShapeRange.WrapFormat.Type = 3 Selection.ShapeRange.ZOrder 4 Selection.ShapeRange.ZOrder msoSendBackward End If End If If Selection <> "" Then If Selection.InlineShapes.Count <> 0 Then 'Selection.InlineShapes(1).Fill.Visible = msoFalse 'Selection.InlineShapes(1).Fill.Solid 'Selection.InlineShapes(1).Fill.Transparency = 0# 'Selection.InlineShapes(1).Line.Weight = 0.75 'Selection.InlineShapes(1).Line.Transparency = 0# 'Selection.InlineShapes(1).Line.Visible = msoFalse 'Selection.InlineShapes(1).LockAspectRatio = msoFalse 'Selection.InlineShapes(1).Width = CentimetersToPoints(28.9) 'Selection.InlineShapes(1).Height = CentimetersToPoints(20.2) 'Selection.InlineShapes(1).PictureFormat.Brightness = 0.5 'Selection.InlineShapes(1).PictureFormat.Contrast = 0.5 'Selection.InlineShapes(1).PictureFormat.ColorType = msoPictureAutomatic 'Selection.InlineShapes(1).PictureFormat.CropLeft = 0# 'Selection.InlineShapes(1).PictureFormat.CropRight = 0# 'Selection.InlineShapes(1).PictureFormat.CropTop = 0# 'Selection.InlineShapes(1).PictureFormat.CropBottom = 0# Selection.InlineShapes(1).ConvertToShape '属性转换（InlineShapes(1)转换为ShapeRange) Selection.ShapeRange.Fill.Visible = msoFalse 'Selection.ShapeRange.AlternativeText = "Higer标书工具修改" Selection.ShapeRange.Fill.Solid Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoFalse Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Width = CentimetersToPoints(28.9) Selection.ShapeRange.Height = CentimetersToPoints(20.2) Selection.ShapeRange.Rotation = 270# 'Selection.ShapeRange.PictureFormat.Brightness = 0.5 'Selection.ShapeRange.PictureFormat.Contrast = 0.5 'Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic Selection.ShapeRange.PictureFormat.CropLeft = 0# Selection.ShapeRange.PictureFormat.CropRight = 0# Selection.ShapeRange.PictureFormat.CropTop = 0# Selection.ShapeRange.PictureFormat.CropBottom = 0# Selection.ShapeRange.RelativeHorizontalPosition = _ wdRelativeHorizontalPositionPage Selection.ShapeRange.RelativeVerticalPosition = _ 。

四、如何用VBA打开固定文件下所有WORD文件,自动运行宏后打印

处理思路为：制作一个Doc文档，里边包含处理过程的代码。需要使用时，将这个doc文档置于需要处理文档所在文件夹中，执行代码即可自动完成。如此即可达到一劳永逸的效果。

为便于使用，建议此doc文档中放置一个命令按钮（CommandButton，可标记为“开始执行”），一个可供显示处理过的文档名称的列表框（ListBox），单击命令按钮执行需要的处理过程，列表显示文档名，过程结束进行相应的提示。

假设您已经置入了CommandButton和ListBox，请双击CommandButton进入代码编辑窗口，将以下代码复制进去，补充完整您需要的一些操作代码即告完成。

'下面是需要复制的代码：

On Error GoTo handerr:

'请先单击代码编辑窗口的菜单“工具/引用”勾选“Microsoft Scripting Runtime”

'否则将无法使用本代码块，放弃使用 Dir 函数是为了不受版本影响

Dim Str1 As String

Dim Fso As New FileSystemObject

Dim Fl As File

Dim Fd As Folder

Dim odoc As Word.Document

If MsgBox（"您确实需要开始执行此过程吗？"， vbQuestion + vbYesNo， "提示"） = vbNo Then

Exit Sub

End If

'清除显示已经处理的文档名列表，如果不需要，把下面一句删除

ListBox1.Clear

Set Fd = Fso.GetFolder(ThisDocument.Path)

'处理每一个文档

For Each Fl In Fd.Files

Str1 = LCase(Fl.Name)

If InStr(1, Str1, ".doc") > 0 And InStr(1, Str1, "~") = 0 And Str1 ThisDocument.Name Then

'如果不需要显示处理的文档名列表，请删除下面一句

ListBox1.AddItem Fl.Name

Set odoc = Documents.Open(CStr(Fl))

odoc.Activate

'下面填写您需要在打开文档后的一些处理动作，如设置页眉，插入图片等

'上面填写您需要处理的一些动作

odoc.Save '保存此文档

odoc.PrintOut '打印此文档

odoc.Close '关闭此文档

End If

Next Fl

'如果上面删除了列表显示语句，请把下面4行删除，再用最后一行进行操作结束

If ListBox1.ListCount > 0 Then

MsgBox "过程执行完毕！" & vbCrLf &； "列表中的" & ListBox1.ListCount &； "个文档等待打印机打印。"， vbInformation， "提示"

Else

MsgBox "过程结束，没有任何文档可操作！"， vbInformation， "提示"

End If

'msgbox "过程结束！"，vbInformation，"提示"

Exit Sub

handerr:

MsgBox Err.Description, vbInformation， "错误提示"

五、怎样一次选中word文档里的所有图片并调整其大小

利用word中的宏可以解决这个问题。

打开VB编辑器，将这个过程分为两个宏来处理：

1.将所有inlineshapes转变为shapes类型；

for each ishapes in selection.inlineshapes

ishapes.converttoinlineshape

next ishapes

2.将所有转化的shapes类型放大一定倍数然后还原为inlineshapes类型：

selection.shaperange.shapewidth 3,false

selection.shaperange.shapeheight 3,false

for each n in selection.shaperanges

n.converttoinlineshape

next n

上式中的两个三代表将长和宽分别扩大三倍。其他的性质可以自己探索~~最后选中图形执行宏就行了！

六、跪求~~~

编辑宏，这个宏按选定的样本图片的大小设置文档中所有图片的大小。

Sub 按选择的图片样本设置图片大小（）

Dim s

Dim r, SelectShape As Boolean

If Selection.InlineShapes.Count = 1 Then SelectShape = True Else If Selection.ShapeRange.Count = 1 Then SelectShape = True

If SelectShape And Selection.InlineShapes.Count = 1 Then

Set s = Selection.InlineShapes(1)

r = Array(s.Height, s.Width)

ElseIf SelectShape Then

Set s = Selection.ShapeRange(1)

r = Array(s.Height, s.Width)

End If

If SelectShape Then

For Each s In ActiveDocument.InlineShapes

s.Height = r(0): s.Width = r(1)

Next s

For Each s In ActiveDocument.Shapes

If InStr(s.Name, "Picture") > 0 Then

s.Height = r(0): s.Width = r(1)

End If

Next s

MsgBox "已经完成对图片大小的设置"

Else

MsgBox "没有选定样本图片"

End If

End Sub

七、word宏只修改选中图片大小的代码,不要批量处理

a = Selection.ShapeRange.Count '获取选中的图片数

if a=10 then '选中10张运行本宏

For Each p In Selection.ShapeRange '也可以为 Selection.InlineShapes p.Width = 100

p.Height = 100

Next

elseif a=8 then '选中8张运行本宏

For Each p In Selection.ShapeRange '也可以为 Selection.InlineShapes

p.Width = 80

p.Height = 80

Next

end if

转载请注明出处51数据库 » wordshaperange