ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 4697|回复: 5

[求助] 将选区内的图片设置为高亮度的VBA代码?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2010-6-9 11:00 | 显示全部楼层 |阅读模式
[local]2[/local]在打印WORD文档时不需要把图片打印出来,但又要保留其图片的占位位置。因此想到把文档中所有图片设置为高亮度!其VBA代码如下:
现在问,若要将选区内的所有图片设置为高亮度,又如何写VBA代码?选区前的全部图片设为高亮度呢?选区后的呢?
对文档中的全部图片我是这样做的:
Sub 图片高亮度设置()
       On Error Resume Next
       For i = ActiveDocument.Shapes.Count To 1 Step -1
            ActiveDocument.Shapes(i).Select
            Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 255, 255)
            Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
            Selection.ShapeRange.PictureFormat.Brightness = 1#
      Next
      For i = ActiveDocument.InlineShapes.Count To 1 Step -1
            ActiveDocument.InlineShapes(i).PictureFormat.Brightness = 1#
      Next
End Sub
附件用来供大家测试。

[ 本帖最后由 yb010 于 2010-6-9 14:03 编辑 ]

删除图片1.rar

144.22 KB, 下载次数: 44

TA的精华主题

TA的得分主题

发表于 2010-8-31 09:13 | 显示全部楼层
原帖由 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

TA的精华主题

TA的得分主题

 楼主| 发表于 2010-9-4 11:34 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2011-9-2 12:36 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2013-1-26 12:40 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-4-4 12:37 | 显示全部楼层
学习学习再学习,向各位大牛致敬!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2025-1-12 07:50 , Processed in 0.024008 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表