调整OLEobject自定义图标的大小

时间:2018-08-27 14:08:14

标签: excel vba excel-vba

我有代码将pdf发票副本插入客户的对帐单。该代码工作正常。只是自定义图标的大小与定义的15x51(HxW)不一致。请建议代码如何调整图标文件的大小以适合此15x51框(M列中的单元格大小,如下图所示)?我正在使用16x16的图标文件。

这是当前结果。

enter image description here

    Sub Insert_PDF_File()
    Application.ScreenUpdating = False

        Dim cell As Range

' loop each cell in column A
        For Each cell In Range("A10:A" & Range("A" & Rows.Count).End(xlUp).Row)
' make sure the cell is NOT empty before doing any work
             If Not IsEmpty(cell) Then

' create and insert a new OleObject based on the path
                Dim ol As OLEObject
' ActiveWorkbook.path & "\" & cell & ".pdf" will make the filename
                Set ol = ActiveSheet.OLEObjects.Add( _
                                                    Filename:="C:\Invoices\Renamed" & "\" & cell & ".pdf", _
                                                    Link:=False, _
                                                    DisplayAsIcon:=True, _
                                                    IconFileName:="C:\Users\pvishwas\Documents\WORK\Macros\PDF.ico", _
                                                    IconIndex:=0, _
                                                    Height:=15, Width:=51, IconLabel:="Open")
' align the OleObject with Column D - (0 rows, 3 columns to the right from column A)
                With ol
                    .Top = cell.Offset(0, 12).Top
                    .Left = cell.Offset(0, 12).Left

                End With
            End If
        Next
    Application.ScreenUpdating = True

    End Sub

1 个答案:

答案 0 :(得分:0)

据我所知,这是由于图标大小。

请检查下面我创建的代码。对象需要给定大小。

Sub AddPDF()

Dim ws As Worksheet
Dim FilePath As String
Dim x As OLEObject

Set ws = ThisWorkbook.Worksheets(1)
FilePath = "D:\certificate-of-earnings.pdf"

ws.Range("A1").Select
ws.OLEObjects.Add Filename:=FilePath, Link:=False, DisplayAsIcon:=True, Height:=15, Width:=51, IconLabel:="PDF"

End Sub 

enter image description here