zoukankan      html  css  js  c++  java
  • VBA 图形图片处理

    学习资源:《Excel VBA从入门到进阶》第44集 by兰色幻想


    本节来学习如何处理VBA图片与图形处理,用到的是VBA的shape对象。

    Shape 对象,该对象代表工作表或图形工作表上的所有图形,它是sheets和chart的子对象(属性)。下表列出shape部分常用属性。

        获取单元格sheet.shape.topleftcell.address

    使用示例:获取shape的l类型。

    Dim ms As Shape
    Cells(k, 1) = ms.Type
    Shape.Type的部分值

    关于shape对象的添加、编辑、变换位置等操作,在这边就略过了。因为这部分内容太多,使用起来也复杂,需要用到时就使用录制宏来获取代码吧。

     

    下面学三段常用的代码:

    1. 图片批量导入

    例题:在B例批量导入A列名称的对应图片。

    要导入的图片

    思路:插入图形,在图形上填充图片。

    因为部分图片分辨率过大,直接插入,可能会导致文件很大。在图形上插入,可以控制图片的大小,和压缩图片。

    提示:关于如何插入图形,可以录制一个插入图形并填充图片的宏,获得代码后再套上循环改写。

    Sub 图片导入()
    
    Dim S As Shape
    Dim RG As Range
    
    '删除已有图片
    For Each S In ActiveSheet.Shapes
        If S.Type <> 8 Then            '有插入一个窗体控件指定宏
            S.Delete                   '把不是窗体控件的shape(图片、图形等)清除
        End If
    Next S
    
    '导入图形
    For Each RG In Range("B2:B5")
        '插入矩形msoShapeRectangle,它的左边距、顶点、宽度、高度都引用RG单元格的
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, RG.Left, RG.Top, RG.Width, RG.Height).Select
        'RG单元格左边单元格填写了图片名称,填充对应图片到矩形里。
        Selection.ShapeRange.Fill.UserPicture "C:" & RG.Offset(0, -1) & ".jpg"
    Next RG
    
    End Sub

    运行示例(逐步展示导入图片,实际用时其实是一秒多):

     

    2. 批量插入复选框

    例题:在B例批量导入复选框。

    提示:先录制一个插入复选框的宏,获得代码后再套上循环改写。

    Sub 批量插入复选框()
    
    Dim RG As Range
    Dim S As Shape
    
    '删除已有复选框
    For Each S In ActiveSheet.Shapes
        If InStr(S.Name, "Ch") > 0 Then      '复选框的名称是Check box
            S.Delete
        End If
    Next S
    
    '批量插入复选框
    For Each RG In Range("B2:B15")
       '插入复选框CheckBoxes,它的左边距、顶点、宽度、高度都引用RG单元格的
        ActiveSheet.CheckBoxes.Add(RG.Left, RG.Top, RG.Width, RG.Height).Select
        
       '复选框的文本为“是”,值为空,链接的单元格是RG的位置
        With Selection
            .Characters.Text = "是"
            .Value = xlOff
            .LinkedCell = RG.Address
        End With
        
       '把RG单元格的字体颜色变成白色,否则打勾会显示True和False
        RG.Font.ThemeColor = xlThemeColorDark1
    
    Next RG
    
    End Sub

    运行示例(逐步批量插入复选框,实际用时不过1秒多):

     

    3. 连线

    例题:把相同内容的单元格连线起来。

    Sub 连线()
    
    Dim rg1 As Range, rg2 As Range, rg3 As Range, rg4 As Range
    Dim S As Shape
    Dim RG As Range
    
    '删除已有线条
    For Each S In ActiveSheet.Shapes
        If S.Type = 9 Then
            S.Delete
        End If
    Next S
    
    '连线
    Set rg1 = Range("B1")
    Set rg2 = Range("B2")
    Set rg3 = Range("C2")
    Set rg4 = Range("C1")
    
    '控制起点和终点,起点为B列单元格的左边线中点,终点为C列单元格的左边线中点
    '没有右边线的说法,所以不能把起点设为A列单元格的右边线中点
    ActiveSheet.Shapes.AddLine(rg1.Left, rg1.Top + rg1.Height / 2, rg3.Left, rg3.Top + rg3.Height / 2).Select
    Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
    ActiveSheet.Shapes.AddLine(rg2.Left, rg2.Top + rg2.Height / 2, rg4.Left, rg4.Top + rg4.Height / 2).Select
    Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
    
    End Sub
    

    运行示例(逐步进行连线,实际用时不超1秒):

     


    小结

    这些例题都比较简单,尤其第三道,只是想把几个可能常用到的实例介绍出来,要想把它们化为己用的话肯定要改写一下,如果需要用到没讲的功能就使用录制宏来获取代码吧,不细讲了~

    这几天有看视频的,就是不知道该怎么做笔记了,因为有些内容也没听太明白,后面可能还会慢更(捂脸……让我想想该怎么做之后的笔记会比较好……

  • 相关阅读:
    第三天 moyax
    mkfs.ext3 option
    write file to stroage trigger kernel warning
    download fomat install rootfs script
    custom usb-seriel udev relus for compatible usb-seriel devices using kermit
    Wifi Troughput Test using iperf
    learning uboot switch to standby system using button
    learning uboot support web http function in qca4531 cpu
    learngin uboot design parameter recovery mechanism
    learning uboot auto switch to stanbdy system in qca4531 cpu
  • 原文地址:https://www.cnblogs.com/plyc/p/14701245.html
Copyright © 2011-2022 走看看