نمایش خودکار تصاویر کوچک یک فایل گرافیکی در اکسل

Question

Ron یک کاربرگ دارد که شامل ستونی حاوی نام فایل‌هایی مانند "abcdef" است. این مربوط به یک فایل JPG ("abcdef.jpg") در همان پوشه کاربرگ است. رون به این فکر می کند که آیا راهی برای نمایش خودکار اکسل وجود دارد، در سلول سمت راست نام فایل، تصویر کوچکی از فایل JPG.

اگر منظور شما از "خودکار" این است که هر زمان که نام فایلی در سلول قرار می گیرد، تصویر ظاهر می شود، این امکان وجود دارد، اما لزوما بهترین راه برای انجام این کار نیست. چرا؟ از آنجایی که کار با فایل‌های گرافیکی می‌تواند منابع زیادی را در کتاب کار شما ببرد، و با افزودن نام فایل‌های بیشتر و بیشتر، مقدار داده‌ای که باید در اطراف جابه‌جا شود می‌تواند بسیار زیاد باشد.

یک رویکرد بهتر این است که یک ماکرو ایجاد کنید که به سلول‌هایی که انتخاب کرده‌اید نگاه می‌کند (آن سلول‌ها باید حاوی نام فایل‌ها باشند) و سپس ریز عکس‌ها را در سمت راست آن سلول‌های انتخاب شده قرار می‌دهد. یک مثال در اینجا آمده است:

Sub Insert_Pics_By_Filename()
    Dim Source As Range
    Dim c As Range
    Dim s As Shape
    Dim sThumbSize As Single
    Dim sPath As String
    Dim sHeight As Single
    Dim sLeft As Single
    Dim xTop As Single   xTop instead of sTop because sTop is a keyword
    Dim sTemp As String

    sThumbSize = 0.75  Picture will be 75% of row height
    Set Source = Selection
    sPath = ActiveWorkbook.Path & ""

     Check the filenames in the cells, first
    For Each c In Source.Cells
        sTemp = c.Value
        If Not (sTemp Like "*.jpg") Then
            c.Select
            MsgBox "Cant work with the filename:" & vbCr & vbCr & sTemp & " in cell " & c.Address
            Exit Sub
        End If
    Next c

     Delete all existing pictures
    For Each s In ActiveSheet.Shapes
        If s.Type = msoLinkedPicture Then
            s.Delete
        End If
    Next s

     Insert the pictures
    For Each c In Source.Cells
        With c
            sHeight = .RowHeight * sThumbSize
            sLeft = .Offset(0, 1).Left + 5    Put 5 pixels from cell left
            xTop = .Top + 5    Put 5 pixels from cell top
            sTemp = .Value

            With ActiveSheet.Pictures.Insert(sPath & sTemp)
                With .ShapeRange
                    .LockAspectRatio = msoTrue
                    .Height = sHeight
                End With
                .Left = sLeft
                .Top = xTop
                .Placement = 1
                .PrintObject = True
            End With
        End With
    Next c
End Sub

ماکرو تصویر کوچکی را ایجاد می کند که 75 درصد ارتفاع ردیف است و آن تصویر کوچک را در سمت راست سلول های انتخاب شده قرار می دهد. اگر یکی از سلول های انتخاب شده ".jpg" را به عنوان بخشی از نام فایل نداشته باشد، متوقف می شود و به شما می گوید که در نام خطایی وجود دارد.

ماکرو خیلی قوی نیست، زیرا می توانید به راحتی آن را خراب کنید. به عنوان مثال، اگر ارتفاع ردیف بسیار کوچک باشد، تصاویر کوچک بسیار کوچک خواهند بود - و اگر خیلی کوچک باشند، ممکن است در درج تصویر بند انگشتی خطای مهلکی رخ دهد. همچنین باید توجه داشته باشید که ماکرو قبل از قرار دادن ریز عکسها، تمام تصاویر موجود در کاربرگ را نیز حذف می کند. به این ترتیب شما در معرض خطر قرار دادن تصاویر تکراری قرار نمی گیرید. اگر می‌خواهید ماکرو فقط بخشی از تصاویر را حذف کند، باید مقدار زیادی ماکرو را دوباره کار کنید تا فقط زیرمجموعه تصاویر مورد نظر را شناسایی کرده و تحت تأثیر قرار دهید.