0

是否可以在 OLEObject 中编辑图标和文本的位置?

像这样

默认布局如图所示,我想这样。

如果这在 VBA 中是可能的,或者可能有替代解决方案,现在有没有人。

这是我的代码:


Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
  (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long

Sub UploadFile()
 Dim iconToUse As String, fullFileName As String, shortFileName As String
 Dim FNExtension As String
 Dim Attachment As OLEObject
 
 'Select file and get path
 fullFileName = Application.GetOpenFilename("*.*, All Files", , , , False)
 
 If fullFileName = "False" Then Exit Sub ' user cancelled
 
 'Choose an icon based on filename extension
 'Get all after last "." in filename
 FNExtension = Right(fullFileName, Len(fullFileName) - InStrRev(fullFileName, "."))
 
 'Get file name only
 shortFileName = Mid(fullFileName, InStrRev(fullFileName, "\") + 1)
 
 'Select icon based on filename extension
 Select Case UCase(FNExtension)
   Case Is = "DOCX"
     iconToUse = "C:\Program Files (x86)\Microsoft Office\root\Office16\WORDICON.EXE"
   Case Is = "XLS", "XLSM", "XLSX"
     iconToUse = "C:\Program Files (x86)\Microsoft Office\root\Office16\XLICONS.EXE"
   Case Is = "PDF"
     iconToUse = "C:\Windows\Installer\{AC76BA86-1033-FFFF-7760-0E1401753200}\_PDFFile.ico"
   Case Else
     iconToUse = "C:\Windows\system32\packager.dll"
 End Select
 
 'Insert til Attachment
 Set Attachment = ActiveSheet.OLEObjects.Add(Filename:=fullFileName, _
   Link:=False, DisplayAsIcon:=True, IconFileName:=iconToUse, _
   IconIndex:=0, IconLabel:=shortFileName, Top:=ActiveCell.Top, _
             Left:=ActiveCell.Left)

End Sub


Function ExePath(lpFile As String) As String
  Dim lpDirectory As String, sExePath As String, rc As Long
  lpDirectory = "\"
  sExePath = Space(255)
  rc = FindExecutable(lpFile, lpDirectory, sExePath)
  sExePath = Left$(sExePath, InStr(sExePath, Chr$(0)) - 1)
 ExePath = sExePath
End Function ```
4

0 回答 0