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 ```