none
Microsoft Office Excel 外接程序开发中,如何删除制定单元格中的图片呢? RRS feed

答案

  •  Public Sub InsertPictrue(ByVal control As Office.IRibbonControl)
            Dim Epp As New Excel.Application
            Epp = Globals.ThisAddIn.Application
            On Error Resume Next
            Dim rg As Excel.Range, k As Excel.Range, k1 As Excel.Range, picPath As String, picTemp As Excel.Picture
            Dim picwd As Double, picht As Double, k2 As Excel.Range, k3 As Excel.Range, n As Integer
            Dim a As Excel.Shape
    
            rg = Epp.InputBox("选择图片显示区域:", "选择区域", Type:=8)
            If rg.Top < 1 Then
                Exit Sub
            End If
            Epp.ScreenUpdating = False
            For Each a In Epp.ActiveSheet.Shapes '删除老图片
                If a.TopLeftCell.Address = rg(1) Then
                    a.Delete()
                    n = n + 1
                End If
            Next
            For Each k In rg
                '选中图片名称的单无格右侧的单元格做为插入图片的地方
                k1 = k.Offset(0, 1)
                k1.Select()
                picPath = "E:\弋赢\报价图\" & Trim(k.Text) & ".png" '选择插入图片
                picTemp = Epp.ActiveSheet.Pictures.Insert(picPath) '插入图片
                picTemp.Name = k.Row
                picwd = picTemp.Width ' 取得图片本身长度
                picht = picTemp.Height ' 取得图片本身宽度
                '如果图片长和宽都小于单元格就拉伸图片
                If picwd < k1.Width - 5 And picht < k1.Height - 5 Then
                    picTemp.Width = k1.Width - 5
                End If
                '如果图片长度大于单元格的长度则缩小
                If picwd > k1.Width Then
                    picTemp.Width = k1.Width - 5
                    If picTemp.Height > k1.Height - 5 Then
                        picTemp.Height = k1.Height - 5
                    End If
                End If
                '如果图片长度大于单元格的高度则缩小
                If picTemp.Height > k1.Height Then
                    picTemp.Height = k1.Height - 5
                End If
                '给图片在单元格中居中
                picTemp.Left = k1.Left + k1.Width / 2 - picTemp.Width / 2
                picTemp.Top = k1.Top + (k1.Height - picTemp.Height) / 2
                picTemp = Nothing
            Next
            Epp.ScreenUpdating = True
    
        End Sub
    自己解决了,汗!~~
    • 已标记为答案 Leck zhou 2014年7月25日 8:35
    • 已编辑 Leck zhou 2014年7月25日 8:37
    2014年7月25日 8:35