精华内容
下载资源
问答
  • 在使用VBA抓取Word文档内容时发现存放在形状里的文字是不能通过paragraphs读到的。如下图所示: 解决思路简述: 外圈for循环遍历Doc文档内所有形状对象得到它们的名字,知道了名字以后用“文本对象.shapes.Range...

    要解决的问题:

    在使用VBA抓取Word文档内容时发现存放在形状里的文字是不能通过paragraphs读到的。如下图所示:

    笔者要处理的大批Word文档的样式模板,箭头所指即存有作者信息的四边形解决思路

    1. 定义一个累加器用来存储本篇Doc文档内读出来的所有字符串
    2. for循环遍历文档内所有的形状(Shapes)
    3. 每遍历到一个就用.Select(形状序号).TextFrame.TextRange.Text读出来,赋值到字符串累加器里
    4. 完成对当前文档所有形状内字符串的遍历,全部内容已存入累加器。
    5. 打印出来或者进行下一步的文本处理

    上代码

    Sub test()
    
    Dim d As Document
    Dim i As Long
    rem 形状名这块纯属个人恶趣味,喜欢在立即窗口里看过程,可以省略
    Dim s_name As String '形状名未知,设置变量存储循环出的shape names
    Dim shape_content As String '把所有shapes里的字符串都放一起供后续分析用
        
        Set d = Application.ActiveDocument '设置活动Doc文档对象
        shape_content = "" '设置空字符串备用,后续将把所有shape里的字符串都放进去
    
            For i = 1 To d.Shapes.Count 'For循环遍历Doc内所有形状
    
            Rem 取得当前shape的名字,用shapes.ranges属性打开Array(当前shape名),对其执行Select方法。Select以后就可以读备选中部分(Selection)里的字符了。
            s_name = d.Shapes(i).Name
            Debug.Print s_name
    
            d.Shapes(i).Select
            On Error Resume Next '箭头之类形状里面没有textframe会报错,直接略过就好
            shape_content = shape_content & "" & d.Shapes(i).TextFrame.TextRange.Text '累加起来,免得作者把内容写在奇奇怪怪的地方
    
            Next '针对Doc文档内各个形状的外圈for循环结束,所有形状里的文字都被一条一条记录进shape_content这个字符串变量里了(条与条间有换行)。最后再VBE的"立即窗口”里打印出来即可查看结果。
    
        Debug.Print shape_content
    
    End Sub
    
    

    立即窗口内显示的流程效果
    ![立即窗口内打印的流程](https://img-blog.csdnimg.cn/d7ef91f93284462eac24fffddd2ec227.png?x-oss-process=image/watermark,type_ZmFuZ3poZW5naGVpdGk,shadow_10,text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3dlaXhpbl80NDg2OTgzNg==,size_16,color_FFFFFF,t_70#pic_center

    后记(应用场景&试错历程):

    本篇博客里记录的其实是我在使用Excel VBA批量摘取Word文档信息时遇到的。为了方便自己和读者快速进入场景就没有再Excel的应用场景里写,而是单列出来备忘。

    大部分图1中的信息(如标题、摘要、教学目标)等都存在于段落中,比较容易摘取。但存储在形状里的作者信息一直找不到合适的方法获取。

    参考网友摘取文本框内容的代码一度反而让我走了更多弯路,多次碰壁后先搞清了作者信息的存储容器是shape–rectangle是第一个突破;后面从shape里面读文本的实现又花了很多功夫——因为一般都是.text直接读的,而这里又是ranges,又是array又是Select的绕了很大的一圈。

    希望有高手指点下是不是有什么更好的方法,兄弟在此先谢过!

    展开全文
  • 因为之前木有这个问题的  重装了下Office就出现这个问题了 百度木有百到 然后看到一位仁兄这样说: 我想是不是微软不给力 需要打补丁 于是安装了下面补丁 果然好了:

    因为之前木有这个问题的 

    重装了下Office就出现这个问题了

    百度木有百到

    然后看到一位仁兄这样说:



    我想是不是微软不给力 需要打补丁

    于是安装了下面补丁 果然好了:


    展开全文
  • 先展示下今天做的效果 按钮1:绑定start1() 按钮2:绑定stop1() 文字旋转效果 图形,形变,变色,旋转效果 四角星是插入的图形,文字是插入的艺术...Set p1 = Worksheets("sheet1").Shapes(1) Set p2 = Workshe...

     

    1 先展示下今天做的效果

    1.1 素材

    • 按钮1:绑定start1()
    • 按钮2:绑定stop1()
    • 文字旋转效果
    • 图形,形变,变色,旋转效果
    • 四角星是插入的图形,文字是插入的艺术字(选择图形效果--选形状)

     

    1.2 对应的代码

    Private switch1
    
    Sub stop1()
    switch1 = False
    End Sub
    
    
    Sub start1()
    Dim p1, p2 As Shape
    Set p1 = Worksheets("sheet1").Shapes(1)
    Set p2 = Worksheets("sheet1").Shapes(4)
    Set p3 = Worksheets("sheet1").Shapes("4-Point Star 3")
    
    
    a = Timer
    switch1 = True
    Do While switch1 = True
    DoEvents
    If Timer - a > 0.1 Then
       a = Timer
        p1.IncrementRotation (10)
        p2.Rotation = p2.Rotation + 5
        p3.Fill.ForeColor.RGB = RGB(255 * Rnd(), 255 * Rnd(), 255 * Rnd())
        p3.Rotation = 90 - Rnd() * 80
        p3.Adjustments(1) = 0.2 * Rnd()
    End If
    Loop
    End Sub

     

    1.3 测试时的各种原始调试代码(废代码很多,仅做备忘)

    Private switch1
    
    Sub stop1()
    switch1 = False
    End Sub
    
    
    Sub start1()
    Dim p1, p2 As Shape
    Set p1 = Worksheets("sheet1").Shapes(1)
    Set p2 = Worksheets("sheet1").Shapes(4)
    Set p3 = Worksheets("sheet1").Shapes(3) 'shapes(3)是btn会造成拒绝的权限,实际四角星是shapes(5)
    'Set ap3 = Worksheets("sheet1").Shapes("autoshape 1")
    Set p3 = Worksheets("sheet1").Shapes("4-Point Star 3")
    
    a = Timer
    switch1 = True
    Do While switch1 = True
    DoEvents
    If Timer - a > 0.1 Then
       a = Timer
        p1.IncrementRotation (10)
    '    p2.Adjustments(1) = 0.1 * Rnd()
    '    p2.IncrementRotation (10)
    '     p2.Rotation = 360 - Rnd() * 350
          p2.Rotation = p2.Rotation + 5
    
    '    p3.Adjustments.Item(1) = 0.1
    '     p3.IncrementRotation (10)
    '     p3.ShapeRange.Rotation = 90 - Rnd() * 80
    '      ap3.ShapeRange.ajustments(1) = 0.1
           p3.Fill.ForeColor.RGB = RGB(255 * Rnd(), 255 * Rnd(), 255 * Rnd())
           p3.Rotation = 90 - Rnd() * 80
           p3.Adjustments(1) = 0.2 * Rnd()
         
    End If
    Loop
    
    End Sub

     

    1.4 代码的关键点和问题总结

    • 注意,找对所要操作的 具体 哪一个 shape
    • 有些shape 并不支持 rotation 等操作
    • 用公共变量在2个开关程序之间传递值
    • 每次条件满足,马上充值 a1=timer


    1.5 报错处理(拒绝的权限和 该形状已经被锁定)

    • 拒绝的权限
    • 该形状已经被锁定
    • 当时忘了bt1 bt2这2个按钮我已经先添加了,这2个也是shape,这是常见思维漏洞
    • 测试发现,button控件,可能并不支持选择,rotation,adjustmen(1) 等等方法
    • 或者是指了sheet1里不存在的控件
    • 所以这几种报错时要了解大致的问题。

     

     

    2 先找到shape,然后才能对其做处理

    • 和worksheets(index) 或 worksheets("name") 一样
    • shapes()这个对象集合,也支持这几种引用方式

     

    2.1 取得shape的 count

    Sub test6()
       Debug.Print Worksheets("sheet1").Shapes.Count
    End Sub

    2.2 取得shape的 index(不支持index()方法,用i遍历变相=index 不知道对不对 )

    • 不支持index()方法,用i遍历变相=index 不知道对不对
    • 看来index是会根据生成顺序重新赋值的
    • 而且会去掉被删掉的index重新排序
    • 也就说,会按照创建次序给shape赋index,而且如果有的shape被删除,会重新按先后次序重排
       
    Sub test7()
    
    
    For i = 1 To Worksheets("sheet1").Shapes.Count
       Debug.Print Worksheets("sheet1").Shapes(i).Name & "它的index是:" & i
    '   Debug.Print Worksheets("sheet1").Shapes(i).Index  '不支持index方法?
    Next
    
    End Sub

     

    2.3 取得shape的name

    Sub test5()
    For i = 1 To Worksheets("sheet1").Shapes.Count
       Debug.Print Worksheets("sheet1").Shapes(i).Name
    Next
    End Sub

     

    3   shapes相关

    3.1 官方资料

     

     

    3.2  shapes.Addshape(msoShapeRectangle, 200, 200, 100, 50)

    • 官方文档
    • https://docs.microsoft.com/zh-cn/office/vba/api/excel.shapes.addshape
    • Shapes.AddShape(msoShapeRectangle, 200, 200, 100, 50)
    • 其中200,200 这些数字单位是 磅。。。
    • 表达式AddShape(键入宽度高度)
    • 其中如果是 msoshapeRectangle, 前2个参数是左上角点的起点pos x,y 而后2个参数是矩形的2个边长,
    • 如果在同一个位置,老shape不会被删除,但是会被新的shape 盖在上层。

     

    Sub t1()
    
    With Worksheets("sheet2").Shapes.AddShape(msoShapeRectangle, 200, 200, 100, 50)
         .Name = "tangle3"
         .Fill.ForeColor.RGB = RGB(255, 0, 255)
         .Line.DashStyle = msoLineDashDot
    End With
    End Sub

     

    shapes.addshape(MsoAutoShapeType, left ,right ,width,height)   通用

     

     

    比较有趣的msoautoshape总结

    • msoshapeOval             圆形或者椭圆,纵轴和横轴一样就是圆形
    • msoshapeRectangle
    • msoshape12pointStar
    • msoshapeBlockArc     圆弧,带厚度的
    • msoshapeChord          横切的部分圆形
    • msoshapeCross
    • msoshapeExplosion1 Explosion2
    • msoshapeGear6         只能是gear6  gear9?
    • msoshapeHexagon    只有6边形?  Octagon 8边型
    • msoShapeParallelogram
    • msoshapeDiamond      菱形,相当于平行四边形把
    • msoshapeSun
    • msoShapeIsoscelesTriangle   等腰三角形,可等边
    • msoShapeRightTriangle         直角三角形
    • msoshapewave
    • msoshapeDoublewave
    • 其实大多数图像,都可以在插入---形状里直接找到

           

       

     

    Sub tf3()
    Dim t1 As Double   't1不能为integer
    Dim sp1 As Shape
    Set sp1 = Worksheets("sheet4").Shapes.AddShape(msoShape12pointStar, 100, 100, 100, 100)
    With sp1
         .Fill.BackColor.RGB = RGB(0, 255, 0)
         .Fill.ForeColor.RGB = RGB(180, 180, 180)
         .Adjustments(1) = 0.2
    End With
    
    
    
    t1 = Timer
    i = 0
    Do While i <= 100
       DoEvents
       If Timer - t1 > 0.1 Then
         t1 = Timer
         i = i + 1
         sp1.IncrementRotation (10)
       End If
    Loop
    
    Debug.Print "end"
    sp1.Delete           '结束时删掉这个shape
    
    End Sub
    

     

    3.3 Shapes.AddLine(180, 180, 300, 180)

    Sub t3()
    
    With Worksheets("sheet2").Shapes.AddLine(180, 180, 300, 180)
         .Name = "line1"
         .Line.ForeColor.RGB = RGB(255, 100, 255)
         .Line.DashStyle = msoLineSolid
    End With
    End Sub
    

     

     

    3.4 Shapes.AddCurve SafeArrayOfPoints:=pts   贝塞尔曲线--没太理解

    • https://docs.microsoft.com/zh-cn/office/vba/api/excel.shapes.addcurve
    • 由指定曲线的顶点和控制点的坐标对组成的数组。 您指定的第一个点是起始顶点, 接下来的两个点是第一段贝塞尔线段的控制点。 该曲线每增加一条线段,就要为其指定一个顶点和两个控制点。您指定的最后一个点是曲线的结束顶点。 请注意,必须指定的点数始终为 3n + 1,其中 n 为曲线的线段个数。
    • SafeArrayOfPoints:=pts 
    • 起点,2控制点,2控制点 .....终点------好像必须是3n+1,比如4,7,10等等
    • 第2维只能是2?

     

    贝塞尔曲线

    https://www.zhihu.com/question/29565629

    https://baike.baidu.com/item/%E8%B4%9D%E5%A1%9E%E5%B0%94%E6%9B%B2%E7%BA%BF/1091769?fr=aladdin

    它通过控制曲线上的四个点(起始点、终止点以及两个相互分离的中间点)来创造、编辑图形。其中起重要作用的是位于曲线中央的控制线。这条线是虚拟的,中间与贝塞尔曲线交叉,两端是控制端点。移动两端的端点时贝塞尔曲线改变曲线的曲率(弯曲的程度);移动中间点(也就是移动虚拟的控制线)时,贝塞尔曲线在起始点和终止点锁定的情况下做均匀移动。注意,贝塞尔曲线上的所有控制点、节点均可编辑。这种“智能化”的矢量线条为艺术家提供了一种理想的图形编辑与创造的工具。


     

    Sub t5()
    Dim pts(1 To 4, 1 To 2) As Single
    pts(1, 1) = 10
    pts(1, 2) = 50
    
    pts(2, 1) = 200
    pts(2, 2) = 120
    
    pts(3, 1) = 150
    pts(3, 2) = 210
    
    pts(4, 1) = 310
    pts(4, 2) = 220
    
    Worksheets("sheet4").Shapes.AddCurve SafeArrayOfPoints:=pts
    
    End Sub

     

    4  shape相关效果

    官方资料

    https://docs.microsoft.com/zh-cn/office/vba/api/excel.shape

     

    4.1 简单汇总(乱的,先记着)

    • shape.IncrementRotation (10)          文本顺时针旋转10度
    • shape.Fill.ForeColor.RGB = RGB(255 * Rnd(), 255 * Rnd(), 255 * Rnd())  变色
    • shape.Rotation = 90 - Rnd() * 80     两种旋转的区别
    • shape.Adjustments(1) = 0.2 * Rnd()   相当于控制图像的 黄色变形点操作
    • shape.name=
    • shape.index=
    • shape.ForeColor.RGB = RGB(255, 0, 255)
    • shape.BackColor.RGB = RGB(255, 0, 255)       '什么情况生效?
    • shape.Line.DashStyle = msoLineDashDot
    • .Adjustments(1) = 0.2   '有黄色控制点的才可以 调整 adjustment属性,比如 msoshapedimand 就没有

     

     

    4.2 旋转相关

    • shape.incrementRotation()          '绕Z轴旋转,也就是垂直于屏幕(的Z轴)旋转
    • shape.incrementRotationZ()       
    • shape.incrementRotationX()      ' 很多形状并不支持,需要3D的才支持
    • shape.incrementRotationY()
    • shape.Rotation()
    •  

     

    4.3 颜色相关

    • shape.forecolor.rgb=rgb()
    • shape.forecolor.rgb=rgb()

     

    4.4 形状相关

    shape.adjustment

     

    4.5 线,边框相关

    shape.line.

     

     

     

    展开全文
  • https://docs.microsoft.com/zh-cn/office/vba/api/excel.shapes.addcurve 由指定曲线的顶点和控制点的坐标对组成的数组。您指定的第一个点是起始顶点, 接下来的两个点是第一段贝塞尔线段的控制点。该曲线每增加一...

     

    1  Shapes.AddCurve SafeArrayOfPoints:=pts   贝塞尔曲线

    • https://docs.microsoft.com/zh-cn/office/vba/api/excel.shapes.addcurve
    • 由指定曲线的顶点和控制点的坐标对组成的数组。 您指定的第一个点是起始顶点, 接下来的两个点是第一段贝塞尔线段的控制点。 该曲线每增加一条线段,就要为其指定一个顶点和两个控制点。您指定的最后一个点是曲线的结束顶点。 请注意,必须指定的点数始终为 3n + 1,其中 n 为曲线的线段个数。
    • SafeArrayOfPoints:=pts 
    • 贝塞尔曲线
    • 起点,2控制点,2控制点 .....终点------好像必须是3n+1,比如4,7,10等等
    • 第2维只能是2?

     

    1.1 贝塞尔曲线

    https://www.zhihu.com/question/29565629

    https://baike.baidu.com/item/%E8%B4%9D%E5%A1%9E%E5%B0%94%E6%9B%B2%E7%BA%BF/1091769?fr=aladdin

    它通过控制曲线上的四个点(起始点、终止点以及两个相互分离的中间点)来创造、编辑图形。其中起重要作用的是位于曲线中央的控制线。这条线是虚拟的,中间与贝塞尔曲线交叉,两端是控制端点。移动两端的端点时贝塞尔曲线改变曲线的曲率(弯曲的程度);移动中间点(也就是移动虚拟的控制线)时,贝塞尔曲线在起始点和终止点锁定的情况下做均匀移动。注意,贝塞尔曲线上的所有控制点、节点均可编辑。这种“智能化”的矢量线条为艺术家提供了一种理想的图形编辑与创造的工具。


     

    Sub t5()
    Dim pts(1 To 4, 1 To 2) As Single
    pts(1, 1) = 10
    pts(1, 2) = 50
    
    pts(2, 1) = 200
    pts(2, 2) = 120
    
    pts(3, 1) = 150
    pts(3, 2) = 210
    
    pts(4, 1) = 310
    pts(4, 2) = 220
    
    Worksheets("sheet4").Shapes.AddCurve SafeArrayOfPoints:=pts
    
    End Sub

     

    1.2 第2个贝塞尔曲线

     

    Sub t6()
    Dim pts(1 To 10, 1 To 2) As Single
    pts(1, 1) = 10         '
    
    pts(1, 2) = 50         '这种分类是错误的
    pts(2, 1) = 200
    
    pts(2, 2) = 120
    pts(3, 1) = 150
    
    pts(3, 2) = 210
    pts(4, 1) = 310
    
    pts(4, 2) = 220
    pts(5, 1) = 110
    
    pts(5, 2) = 280
    pts(6, 1) = 190
    
    pts(6, 2) = 220
    pts(7, 1) = 150
    
    pts(7, 2) = 210
    pts(8, 1) = 310
    
    pts(8, 2) = 220
    pts(9, 1) = 110
    
    pts(9, 2) = 280
    pts(10, 1) = 190
    
    pts(10, 2) = 210
    
    
    Worksheets("sheet5").Shapes.AddCurve SafeArrayOfPoints:=pts
    
    End Sub

     

    1.3 根据这个原理,控制4个点,果然可以画出想要的这种波浪曲线

    • 起点: 和终点在同一个高度
    • 终点:X大,Y=Y起点
    • 控制点1:X前进,Y往上
    • 控制点2:X继续前进,Y往下

     

     

    Sub t5()
    Dim pts(1 To 4, 1 To 2) As Single
    pts(1, 1) = 0           '第1个点的X坐标
    pts(1, 2) = 150         '第1个点的Y坐标
    
    pts(2, 1) = 150         '第2个点的X坐标
    pts(2, 2) = 0
    
    pts(3, 1) = 200         '第3个点的X坐标
    pts(3, 2) = 300
    
    pts(4, 1) = 400
    pts(4, 2) = 150
    
    Worksheets("sheet4").Shapes.AddCurve SafeArrayOfPoints:=pts
    
    End Sub
    展开全文
  • VBA批量删除Shape

    千次阅读 2018-08-13 12:40:00
    If n > 0 Then sht.Shapes.Range(arr).Delete n = 0 Next sht End Sub 删除当前工作表图片 Sub Clear_Picutes() Dim Shp As Shape For Each Shp In ActiveSheet.Shapes If Shp.Type = msoPicture Then Shp....
  • VBA各对象的属性、方法查询集 VBA各对象的属性、方法查询集
  • Vba Word Shape&TextBox

    2020-06-29 23:44:47
    因为Word里面不一定全部包含在Application Content里面,有些TEXT是存在在TextBox,而TextBox属于Shape,所以可以循环获取... For Each Shp In ThisDocument.Shapes Debug.Print Shp.TextFrame.TextRange.Text ...
  • 1 To itSheet.Shapes.Count If itSheet.Shapes.Item(i).Type = msoChart Then itSheet.Shapes.Item(i).Delete End If Next '插入图表 Dim itShapes As Shape Set itShapes = itSheet.Shapes.AddChart2(332, ...
  • VBA】工作表删除所有图片、形状

    千次阅读 2018-11-07 11:13:13
    Dim shp As Object  For Each shp In ActiveSheet.Shapes  shp.Delete  Next shp  
  • 1. 如何在word中打开VBA编辑器?ALT+F112. 如何运行VBA代码?https://wenku.baidu.com/view/5b7edafea45177232f60a2e8.html 在代码编辑区输入如下代码:Sub A() MsgBox ("hello") End Sub点击绿色的三角按钮即可...
  • newChar.word = oSlide.Shapes.Item(1).TextFrame.TextRange.Text Call searchWordFromBaidu(newChar.word, newChar.trans, newChar.phonetic) oSlide.Shapes.Item(2).TextFrame.TextRange.Text = newChar.trans...
  • ​如果需要制作如图1所示的产品目录,因为所需图片的尺寸...使用VBA可以快速完成这一系列繁杂的操作,示例代码如下。 Sub InsertPictures() Dim lngRow As Long Dim objShape As Shape Dim objTargetCell As R...
  • Excel VBA-批量导出图片.vba

    千次阅读 2018-10-24 10:53:50
    'r,c 图片所在单元格的偏移量,用来做图片的名字 Sub exportPic() r = 0 c = -2 For i = 1 To ActiveSheet.Shapes.Count ActiveSheet.Shapes(i).... Name = Range(ActiveSheet.Shapes(i).TopLeftCell.Address).Of...
  • Word-VBA:替换文字

    千次阅读 2020-09-09 12:11:13
    '工具-引用 Microsoft Word 16.0 Object Library (16会因为机器安装的版本不一) WordApp.Selection.Find.ClearFormatting WordDoc.Range.Find.Execute findtext:="被替换掉啥", ReplaceWith:="替换成啥", ...
  • Sheet1.Shapes("PIC").CopyPicture ‘对图形命名为PIC,也可以用序号调用Shapes(1) With Sheet1.ChartObjects.Add(0, 0, Sheet1.Shapes("PIC").Width, Sheet1.Shapes("PIC").Height).Chart .Paste .Export ...
  • 在程序开发中,user给了本人一个excel,里面有几百个长方形,需要将这些长方形展示在页面中。 首先想到的是需要每个...本人是vba小白,通过百度获取相关知识,下面是我的大致步骤,如有错误之处,请同仁不啬赐教。 ...
  • 图中的Shapes(1).GroupItems.Count=4,序号如图。 用下面的方法读取2、3、4的文本都没问题: Debug.Print ActivePresentation.Slides(1).Shapes(1).GroupItems(2).TextFrame.TextRange.Text Debug.Print ...
  • Set p1 = Worksheets("sheet7").Shapes.AddShape(msoShapeOval, 100, 100, 200, 100) p1.Fill.ForeColor.RGB = RGB(0, 0, 250) With p1.ThreeD .Visible = True .Depth = 100 .ExtrusionColor.RG...
  • Vba菜鸟教程

    万次阅读 多人点赞 2020-05-02 18:21:15
    文章目录Vba菜鸟教程编辑器宏vba基本语法运算符变量语句简写语句sub语句调用语句退出语句分支语句循环语句判断语句公式与函数在单元格输入公式利用单元格公式返回值调用工作表函数利用vba函数自定义函数操作对象操作...
  • Sub ftest1() Dim p1 As Shape Set p1 = Worksheets("sheet6").Shapes.AddShape(msoShapeOval, 100, 100, 200, 100) p1.Fill.ForeColor.RGB = RGB(0, 0, 250) With p1.ThreeD .Visible = True .Depth = 100 ....
  • Excel VBA 处理图形图表详解
  • 的循环,单元格(Tables(Item).Range.Cells)的循环,自选图形(Shapes)的循环,域(Fields) 的循环,书签(Bookmarks)中的循环等等,函数的应用、选择性分支语句、判断语句、 错误处理、类模块的使用、用户窗体的使用、...
  • Sub 遍历所有工作表_删除所有图片() Dim shp As Shape, sht As Worksheet Rem On Error Resume Next '忽略报错,防止有#N/A Rem 遍历所有工作表 ... For Each shp In sht.Shapes shp.Delete .
  • VBA批量调整图片宽度

    千次阅读 2016-04-17 09:44:29
    ActiveDocument.Shapes.Count oldWidth = ActiveDocument.InlineShapes(i).Width oldHeight = ActiveDocument.InlineShapes(i).Height '如果长度大于内容区的长度则自动修改图片长度为内容区,图片高度按照比例...
  • 在模块Manipulations中添加代码: Sub MoveTextBox() With ActiveSheet.Shapes(1) .Select .Left = 200 .Top = 20 End With End Sub Sub MoveCircle() With ActiveSheet.Shapes(2) .Select .Left = 0 .Top = 0 End ...
  • Sub printshapesname() Z = ActiveSheet.Shapes.Count For s = 1 To ActiveSheet.Shapes.Count Debug.Print ActiveSheet.Shapes(s).Name Next End Sub
  • Word VBA-图片操作汇总

    2021-05-28 09:38:43
    ========================== Sub 图片后加回车() Dim s As Shape ... For Each s In ActiveDocument.Shapes With s If s.Type = msoPicture Then s.ConvertToInlineShape End If End With Next s
  • 王佩丰VBA学习笔记

    千次阅读 2020-11-02 17:26:43
    VBA笔记 王佩丰VBA学习笔记 (按照课程分类) for循环 for i = a to b next (先 dim) Sub gzt() Rows(“1:1”).Select Dim i As Integer For i = 1 To 10 Selection.Copy ActiveCell.Offset(2, 0).Rows(“1:1”)....
  • 将文本中的一个文本字符串替换为另一个文本字符串。此代码片示例将页面上所有出现的“#”替换为当前日期。 参考代码 Sub test() ' 定义形状变量 Dim s As Shape ' 遍历当前页面所有的文本形状(通过查找) ...

空空如也

空空如也

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

shapesvba