|
原帖由 yb010 于 2010-6-9 11:00 发表
[local]2[/local]在打印WORD文档时不需要把图片打印出来,但又要保留其图片的占位位置。因此想到把文档中所有图片设置为高亮度!其VBA代码如下:
现在问,若要将选区内的所有图片设置为高亮度,又如何写VBA代码?选 ...
请参考:
Option Explicit
Public Enum udtrngType
udtrngAll = 0
udtrngSelection = 1
udtrngBeforeSelection = 2
udtrngAfterSelection = 3
End Enum
Sub Example()
Call 图片高亮度设置(udtrngAfterSelection)
End Sub
Private Sub 图片高亮度设置(rngType As Long)
On Error GoTo ErrHandle:
Dim myRange As Word.Range
Dim oInlineShape As Word.InlineShape
Dim oShape As Word.Shape
Dim myShapeRange As Word.ShapeRange
Set myRange = GetCurrentRange(rngType)
For Each oInlineShape In myRange.InlineShapes
oInlineShape.PictureFormat.Brightness = 1#
Next
Set myShapeRange = myRange.ShapeRange
If myShapeRange.Count > 0 Then
For Each oShape In myShapeRange
With oShape
.Line.ForeColor.RGB = RGB(255, 255, 255)
.Line.BackColor.RGB = RGB(255, 255, 255)
Select Case .Type
Case msoEmbeddedOLEObject, msoPicture, msoLinkedPicture '''根据测试情况增加图形类型
.PictureFormat.Brightness = 1#
End Select
End With
Next
End If
Exit Sub
ErrHandle:
MsgBox Err.Number & vbCrLf & Err.Description, vbExclamation, "Rousoft Office"
End Sub
Private Function GetCurrentRange(rngType As udtrngType) As Word.Range
Dim myRange As Word.Range
With ActiveDocument
Select Case rngType
Case udtrngAll
Set myRange = .Content
Case udtrngSelection
Set myRange = Selection.Range
Case udtrngBeforeSelection
Set myRange = .Range(0, Selection.Start)
Case udtrngAfterSelection
Set myRange = .Range(Selection.End, .Content.End)
End Select
End With
Set GetCurrentRange = myRange
End Function |
|