我有一个包含几张图片的文件夹。我想在第一列导入文件的名称,图像作为注释(您可以添加注释并用图像填充),第二列的像素尺寸(Es:800x600)。
有可能这样做吗?我有太多的图像要处理。多谢!
Sub tgr()
Const strFolderPath As String = "C:\Test"
Dim rngDest As Range
Dim oShell As Object
Dim varFileName As Variant
Dim strDimensions As String
Set oShell = CreateObject("Shell.Application").Namespace(strFolderPath)
Sheets.Add
With Range("A1:B1")
.Value = Array("Name", "Dimensions")
.Font.Bold = True
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
Set rngDest = Range("A2")
On Error Resume Next
For Each varFileName In oShell.Items
strDimensions = oShell.GetDetailsOf(varFileName, 26)
If Len(strDimensions) > 0 Then
With rngDest
.Resize(, 2).Value = Array(varFileName, strDimensions)
.Comment.Delete
.AddComment
.Comment.Shape.Fill.UserPicture strFolderPath & Application.PathSeparator & varFileName
End With
Set rngDest = rngDest.Offset(1)
End If
Next varFileName
On Error GoTo 0
Range("A:B").EntireColumn.AutoFit
Set rngDest = Nothing
Set oShell = Nothing
End Sub