-1

我有一个包含几张图片的文件夹。我想在第一列导入文件的名称,图像作为注释(您可以添加注释并用图像填充),第二列的像素尺寸(Es:800x600)。

有可能这样做吗?我有太多的图像要处理。多谢!

4

1 回答 1

0
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
于 2013-08-09T19:54:19.863 回答