Excel中利用VBA自定义图片批注
责任编辑:hylng    浏览:1646次    时间: 2012-12-31 23:13:56      

摘要:功能:在当前单元格插入图片批注 '说明:1、如果选择的是单元格区域,则把单元格区域的内容做为批注的图片 ' 2、如果选择的是图片,则把此图片做为成批注的图片 '******************************************* Dim RngAddress As String, Files As String, Rng As Ra..

分享到:
功能:在当前单元格插入图片批注
'说明:1、如果选择的是单元格区域,则把单元格区域的内容做为批注的图片
'      2、如果选择的是图片,则把此图片做为成批注的图片
'*******************************************
Dim RngAddress As String, Files As String, Rng As Range, Widths As Integer, heights As Integer
    RngAddress = ActiveCell.Address: Files = "C:\pz.BMP" '记录活动单元格地址和临时文件地址
    If TypeName(Selection) = "Range" Then   '如果选择单元格
    On Error Resume Next
star:
        Set Rng = Application.InputBox("请选择区域", "区域", RngAddress, Type:=8) '选择一个区域做批批注的引用源
        If Err <> 0 Then Err.Clear: GoTo star '单击取消则重新提示选择区域
        Application.ScreenUpdating = False
        Range(Rng.Address).CopyPicture '复制对象
        ActiveSheet.Paste '粘贴
        Set Shp = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
        Widths = Shp.Width: heights = Shp.Height '获取图片高度与宽度
        Selection.Delete '删除临时图片
    ElseIf TypeName(Selection) = "Picture" Then '如果选择了图片
        Application.ScreenUpdating = False
        Selection.CopyPicture '复制为图片
        Set Shp = ActiveSheet.Shapes(Selection.Name)
        Widths = Shp.Width: heights = Shp.Height '记录高度与宽度
    Else
        Exit Sub
    End If
    OpenClipboard 0 '打开剪贴板
    DeleteEnhMetaFile CopyEnhMetaFileA(GetClipboardData(14), Files) '导出剪贴板中的图片
    CloseClipboard  '关闭
    Application.CutCopyMode = False
    Range(RngAddress).Select  '激活单元格
    Range(RngAddress).ClearComments  '清除批注
    With Range(RngAddress).AddComment.Shape '清加批注
        .Width = Widths  '指定宽度
        .Height = heights '指定高度
        .Fill.UserPicture Files '填充图片
    End With
    Kill Files '清除临时文件
    Application.ScreenUpdating = True
    Set Shp = Nothing
End Sub
】【打印繁体】【投稿】 【收藏】 【推荐】 【举报】 【评论】 【关闭】【返回顶部
发表评论
帐  号: 密码: (新用户注册)
验 证 码:
表 情:
内  容:
发表评论
用户评价(0)

暂时还没有任何评论