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