• Excel中利用VBA自定義圖片批注
    責任編輯:hylng    瀏覽:1888次    時間: 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)

    暫時還沒有任何評論

    辽宁卫视爱的选择直播