Question

我有一个包含多张图片的文件夹。我想在第一列导入文件的名称，图像作为注释（您可以添加注释并填充图像），第二列上的像素尺寸（Es：800x600）。

有可能这样做吗？我有太多的图像可供使用。非常感谢！

Answer 1

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

将数据文件从文件夹图像导入excel列

1 个答案: