精华内容
下载资源
问答
  • Sub tongyixiugaichicun() Dim oInlineShape As InlineShape For Each oInlineShape In ActiveDocument.InlineShapes With oInlineShape .LockAspectRatio = msoFalse '不锁定纵横比 ' .ScaleHeight = 10 ...

     Sub tongyixiugaichicun()
     Dim oInlineShape As InlineShape
        For Each oInlineShape In ActiveDocument.InlineShapes
            With oInlineShape
                .LockAspectRatio = msoFalse    '不锁定纵横比
              ' .ScaleHeight = 10
              .Width = CentimetersToPoints(8)
              .Height = CentimetersToPoints(6)
             '  .ScaleWidth = 10
            End With
        Next
    End Sub
     

    展开全文
  • VBA_批量调整图片宽度

    千次阅读 2017-04-09 15:54:58
    '版心尺寸大小(假设 Word 2003 中,A4纵向纸张,宽度已知是21厘米,左边距2.5厘米,右边距2.5厘米,所以,版心尺寸=宽度-左边距-右边距=16厘米) Dim Width As Single, Left As Single, Right As Single Width = ...
    '版心尺寸大小(假设 Word 2003 中,A4纵向纸张,宽度已知是21厘米,左边距2.5厘米,右边距2.5厘米,所以,版心尺寸=宽度-左边距-右边距=16厘米)
        Dim Width As Single, Left As Single, Right As Single
        Width = Round(ActiveDocument.PageSetup.PageWidth / 28.35)
        Left = Round(ActiveDocument.PageSetup.LeftMargin / 28.35, 1)
        Right = Round(ActiveDocument.PageSetup.RightMargin / 28.35, 1)
        MsgBox "版心尺寸是 " & (Width - Left - Right) & " 厘米"
    
    
    Sub 图片宽度批量调整()
    Dim i
    Dim j
    Dim oldHeight
    Dim oldWidth
    Dim newHeight
    Dim newWidth
    Dim docWidth
    docWidth = 15 * 28.345
    
    On Error Resume Next
    For i = 1 To ActiveDocument.InlineShapes.Count
     oldWidth = ActiveDocument.InlineShapes(i).Width
     oldHeight = ActiveDocument.InlineShapes(i).Height
     '如果长度大于内容区的长度则自动修改图片长度为内容区,图片高度按照比例压缩
     If oldWidth > docWidth Then
         newWidth = docWidth
         newHeight = newWidth * oldHeight / oldWidth
     End If
     ActiveDocument.InlineShapes(i).Height = newHeight '修改为自己需要的值
     ActiveDocument.InlineShapes(i).Width = newWidth '修改为自己需要的值
    
    Next
    For j = 1 To ActiveDocument.Shapes.Count
      oldWidth = ActiveDocument.InlineShapes(i).Width
      oldHeight = ActiveDocument.InlineShapes(i).Height
     '如果长度大于内容区的长度则自动修改图片长度为内容区,图片高度按照比例压缩
     If oldWidth > docWidth Then
         newWidth = docWidth
         newHeight = newWidth * oldHeight / oldWidth
     End If
     ActiveDocument.InlineShapes(j).Height = newHeight '修改为自己需要的值
     ActiveDocument.InlineShapes(j).Width = newWidth '修改为自己需要的值
    
    Next
    
    End Sub
    
    展开全文
  • 在word里保存比较大的图片,都大得超出了word的边界了,也没有居中,数量又多,不可能手动一张张调整。 第一种方法经过测试,只是前面部分有效,后面部分无效。 Sub setpicsize() '设置图片尺寸 '第一种方法,经...

    在word里保存比较大的图片,都大得超出了word的边界了,也没有居中,数量又多,不可能手动一张张调整。

    第一种方法经过测试,只是前面部分有效,后面部分无效。

    Sub setpicsize() '设置图片尺寸
    
    '第一种方法,经测试,文档前面部分图片有效,后面部分无效
        'Dim n '图片个数
        'On Error Resume Next '忽略错误
        'For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes 类型 图片
        'ActiveDocument.InlineShapes(n).Height = 198.45 '设置图片高度为 7cm
        'ActiveDocument.InlineShapes(n).Width = 455 '单位是像素,设置图片宽度 16cm
        'Next n
    End Sub

     第二种方法,经测试,对整篇文档图片有效:

    Sub 设置图片格式()
        '1.如果图片行间距设置为固定值,那么无论图片设置什么格式,图片嵌入文字会重叠,只显示部分图片。
        '2.如果图片超出边界才进行处理,设置全文图片大小不超过某个规格,超过则等比例缩小
        Dim picMaxWidth, picMaxHeight, picWith, picHeight As Long
        '纸张宽减去左右边距,不用再乘以28.35,已经是像素
        picMaxWidth = (ActiveDocument.PageSetup.PageWidth - ActiveDocument.PageSetup.LeftMargin - ActiveDocument.PageSetup.RightMargin)
        picMaxHeight = (ActiveDocument.PageSetup.PageHeight - ActiveDocument.PageSetup.TopMargin - ActiveDocument.PageSetup.BottomMargin)
        Dim oILS As InlineShape
        For Each oILS In ActiveDocument.InlineShapes 'Selection.InlineShapes
            If oILS.Type = wdInlineShapePicture Then
            oILS.Select
                oILS.LockAspectRatio = msoTrue '锁定纵横比,防止默认没有锁定修改了图片变形;不锁定纵横比是msoFalse
                Selection.Range.ShapeRange.LockAspectRatio = msoTrue
                'MsgBox("图片宽度" & oILS.Width) '测试,提示图片大小以便判断单位'此处单位是像素。
                picWidth = oILS.Width
                picHeight = oILS.Height
                If oILS.Width > picMaxWidth Then
                    'Word中的尺寸单位默认是cm(厘米),而1cm等于28.35px(像素),由于代码中换算设置的单位是px(像素)。
                    '所以就用尺寸高度或宽度值乘像素值。即为:7*28.35=198.45;宽度换算方法与此相同。
                    oILS.Width = Abs(picMaxWidth) '此处单位是厘米。如果Word设置页边距为适中,则中间内容宽17.08CM
                    '注意:如果此处不设置图片高度,即使锁定纵横比,图片纵横比也会改变,不知道为什么?
                    oILS.Height = oILS.Width * picHeight / picWidth 'CentimetersToPoints(7)
                End If
                '可能超过宽度调节后,高度还是超出了
                If oILS.Height > picMaxHeight Then
                    oILS.Height = Abs(picMaxHeight)
                    oILS.Width = oILS.Height * picWidth / picHeight
                End If
    
                'oILS.Range.Select
                'Selection.ClearFormatting
                'Selection.Range.Paragraphs.Alignment = wdAlignParagraphCenter
                With oILS
                    .Range.ParagraphFormat.Reset
                    '.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle '单倍行距
                    .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter '居中
                End With
            End If
        Next
    End Sub

    上述代码注意两点,一是即使设置了锁定纵横比,如果只设置了宽度或者高度其一,图片依然没有等比例缩小,所以高度和宽度都要设置才行。

    二是宽度缩小后,高度仍可能超出页面,所以还需要对高度再检查和缩小一次。

    展开全文
  • Dim WordApp As Object Set WordApp = CreateObject("Word.Application") WordApp.Visible = True Dim WordDoc As Object ...PicPath="图片地址" WordApp.ActiveDocument.Bookmarks("BM1_1").Range.Se.
    Dim WordApp As Object
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True
    Dim WordDoc As Object
    Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\TEST.docx")
    
    PicPath="图片地址"
    WordApp.ActiveDocument.Bookmarks("BM1_1").Range.Select 'Word里定义书签BM1_1
    Set Pic = WordApp.Selection.InlineShapes.AddPicture(Filename:=PicPath, SaveWithDocument:=True) '插入图片
    Set Shape = Pic.ConvertToShape '转为Shape后才可以调整
    Shape.Top = Shape.Top + 10
    Shape.Left =  10
    Shape.Width = 10
    Shape.Height = 10
    
    '嵌入式  -未验证
    Shape.WrapFormat.Type = wdWrapTight '紧密环绕
    
    'wdWrapInline 嵌入式
    'wdWrapNone 改为默认
    'wdWrapSquare 四周环绕
    'wdWrapThrough 穿越环绕
    'wdWrapTopBottom 上下环绕

    因为要用到Word中的一些常规变量,所以需要引用Microsoft Word 16.0 Object Library  (版本号16因各人PC中安装的版本不同)

    展开全文
  • 使用VBA能够批量修改,处理繁琐的操作,解放双手~ 本文对应的软件是word2013版。 具体步骤: 1.新建一个能够用宏的文档类型:dotm。 2.一次插入所有的图片 3.点击“宏” 在弹出的窗口中输入宏名...
  • Sub adjustpic() '根据合并单元格大小调整图片大小 Dim Pic As Shape For Each Pic In ActiveSheet.Shapes  If Pic.TopLeftCell.MergeCells = True Then  Set cc = Pic.TopLeftCell.MergeArea  Pic.LockAspec
  • VBA批量调整图片宽度

    千次阅读 2016-04-17 09:44:29
    上午花了点时间写了段代码调整WPS文字中图片的宽度,直接看图。 代码如下:Sub 图片宽度批量调整() Dim i Dim j Dim oldHeight Dim oldWidth Dim newHeight Dim newWidth Dim docWidth docWidth = 15 * 28.345On ...
  • EXCEL VBA 导入图片自适应大小

    千次阅读 2015-12-07 10:56:38
     On Error Resume Next '忽略错误继续执行VBA代码,避免出现错误消息  '图片路径  pic_url = "d:\我的文档\桌面\"  '图片所在的列  pic_column_num = "C"  '图片宽度  pic_width = 100
  • 图片自适应单元格代码
  • 打开文件,启用宏,查看宏代码,复制代码到自己的文档中的宏代码中
  • 6.图片大小会自动适应你设定的第一行要插入图片的单元格,因此提前调整那个单元格的大小可以控制插入图片大小。 ------------- 删除活动工作表中所有图片 Ctrl+d 删除活动工作表里所有的JPG图片,(不一定是本...
  • Sub 批量调整图片大小() ' ' 批量调整图片大小 宏 ' ' Dim n ' 图片个数 On Error Resume Next ' 忽略错误 For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes 类型图片 ActiveDocument.InlineShapes(n...
  • 如果您有一推图片大小一样,想用word转成PDF,那么我推荐您使用VBA调整图片大小,先给word设置 “页面布局-页边距”全部设置成0,再调整成合适的纸张大小,然后启动VBA 【Alt +F11】,粘贴如下代码,修改代码中...
  • 直接上代码在sheet1里面,顺便修改sheet1为Sht1 Sub Image_Change() Dim x%, y%, w%, h%, iPath$ ... With ActiveSheet.Shapes.Range(Array("图片")) x = .Left '记录坐标点 y = .Top '记录坐标点 w = .Wi...
  • QRMark二维码调整大小的方法,QRMark二维码调整大小的方法,QRMark二维码调整大小的方法,亲测可用!!!
  • 调整指定区域的大小。返回 Range 对象,该对象代表调整后的区域。 语法 表达式.Resize(RowSize, ColumnSize) 表达式一个返回 Range 对象的表达式。 参数 名称 必选/可选 数据类型 说明 RowSize ...
  • wps 批量调整图片大小

    千次阅读 2019-09-20 22:07:41
    1 Sub 批量调整图片大小() 2 ' 3 ' 批量修改图片 Macro 4 ' 宏由 zxz 录制,时间: 2014/10/29 5 '批量调整图片大小,避免图片太大显示不完全 6 7 '循环图片集合 8 For Each iShape In ActiveDocument...
  • '调整图片高度宽度等于单元格宽度 Sub setpic() Dim Pic As Shape  For Each Pic In Sheet5.Shapes  Pic.LockAspectRatio = msoFalse  Pic.Top = Pic.TopLeftCell.Top  Pic.Left = Pic.TopLeftCell.L
  • 批量调整图片大小.mdb

    2021-09-08 19:33:28
    批量调整图片大小
  • 设置图片格式 Sub setShapeStyle() ' 声明个内嵌图片(暂时没用到) Dim theShape As InlineShape ' 关闭屏幕更新 Application.ScreenUpdating = False For Each myShape In ActiveDocument.InlineShapes ...
  • 好不容易做完了100页的活动方案,交到处女座上司那里,他告诉我:“Word里面的图片要统一尺寸,还有…必须居中!”。这不是逼人辞职吗?你早不说,现在文件做完了,你要我近百张Word图片一个个改尺寸、居中,咋不...
  • 应用场景:56张图改同样的尺寸大小。 为什么做了这个:corelDRAW目前不支持批量修改图片尺寸,改了56张好浪费时间 主函数 main: Private Sub Document_QueryClose(Cancel As Boolean) End Sub 窗口界面: ...
  • 什么?你不知道照相机是什么??那参见我这篇文章吧 ...VBA Private Sub pictureSheet() Dim Sht As Worksheet Dim iSht As Worksheet Dim iCnt%,eRow%,eCol% IMG_NAME = "img" '用于存放图片的工
  • Sub 插入图片() Dim filenames As String  Dim filefilter1 As String  filefilter1 = ("所有图片文件(*.jpg;*.bmp;*.png;*.gif),*.jpg;*.bmp;*.png;*.gif") '所有图片文件后面的括号为中文括号 ...
  • word用宏修改文档中图片大小

    千次阅读 2018-10-09 09:26:54
    记录一下,批量改图是一个很好的思路.早就听说了word宏,一直没有用过.今天(20171207)用了下,觉得的确不错. 操作步骤: 1 ALT+F8 进入宏编辑模式,输入name-... 3 宏代码中调整要设置的大小 Mywidth ,Myhe...
  • excel插入图片(利用vba

    千次阅读 2019-02-19 10:00:18
    3. 单元格的大小调整照片插入的大小 4. 复制下面vba代码,红字前的属性注意修改,红字不需删除 -------------------------------------------------复制分割线以下内容----------------------------------------...
  • EXCEL表格只能够修改整个图表的大小,但是无法调整绘图区的大小。而在写论文,做ppt的时候经常会展示多个子图,为了美观,通常要求各个子图的绘图区要大小一致。本文介绍了一种方法来实现绘图区大小的精确调整。 1...
  • 在EXCEL里,需要大量引用网上链接图片,例如python的爬虫把图片链接爬取之后,需要在EXCEL内展示图片,可以使用VBA批量将URL链接地址图片转为图片; 1.复制以下代码到VBA内,(不知道VBA是什么的传送门:...
  • Excel 宏实现图片按比例缩放

    千次阅读 2015-10-31 21:36:06
    本文主要介绍通过Excel 宏实现选中图片按比例缩放(如:图片缩小67%)。 下面代码实现功能: ①如果选中的内容是图片,将图片缩小67%。 ②缩放的同时横向和纵向按原始固定比例。 ③如果选中的内容不是图片,...
  • word中如何将大量图片批处理统一的尺寸大小

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 1,393
精华内容 557
关键字:

vba调整图片大小