Macro to insert most recent image as background for text boxes

X

Xx7

Board Regular
Joined
Jan 29, 2011
Messages
126
I have a bunch of images in a folder. I want a macro that inserts the most recent image that was put into the folder into a text box.

Here's what I came up with using the macro recorder. But how do I make it select the most recent one?

Code: 
Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 195, 63, 292.5, 207 _
        ).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .PresetTextured msoTexturePapyrus
        .TextureTile = msoTrue
        .TextureOffsetX = 0
        .TextureOffsetY = 0
        .TextureHorizontalScale = 1
        .TextureVerticalScale = 1
        .TextureAlignment = msoTextureTopLeft
    End With
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .UserPicture "C:\Users\BD\Desktop\Pic1.png"
        .TextureTile = msoFalse
    End With
End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Sort by date Sort by votes
Assuming that only image files exist in the folder, the following macro selects the one with the most recent creation date...

Code: 
[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] test()

    [color=green]'Set up a reference to the Windows Script Host Object Model in the Visual Basic Editor[/color]
    [color=green]'Tools > References > Windows Script Host Object Model[/color]

    [color=darkblue]Dim[/color] objFSO [color=darkblue]As[/color] FileSystemObject
    [color=darkblue]Dim[/color] objFolder [color=darkblue]As[/color] Folder
    [color=darkblue]Dim[/color] objFile [color=darkblue]As[/color] File
    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strFileName [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] dtDate [color=darkblue]As[/color] Date
    
    [color=green]'Change the path to the folder accordingly[/color]
    strPath = "C:\Users\Domenic\Desktop"
    
   [color=darkblue]Set[/color] objFSO = CreateObject("Scripting.FileSystemObject")
   
   [color=darkblue]Set[/color] objFolder = objFSO.GetFolder(strPath)
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] objFile [color=darkblue]In[/color] objFolder.Files
        [color=darkblue]If[/color] objFile.DateCreated > dtDate [color=darkblue]Then[/color]
            strFileName = objFile.Path
            dtDate = objFile.DateCreated
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] objFile
    
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 195, 63, 292.5, 207).Select
    
    [color=darkblue]With[/color] Selection.ShapeRange.Fill
        .Visible = msoTrue
        .PresetTextured msoTexturePapyrus
        .TextureTile = msoTrue
        .TextureOffsetX = 0
        .TextureOffsetY = 0
        .TextureHorizontalScale = 1
        .TextureVerticalScale = 1
        .TextureAlignment = msoTextureTopLeft
        .UserPicture strFileName
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]
 
Upvote 0
Works like a charm!! unbelievable.. thanks alot :)

Quick follow-up question (different macro)...

If I have a bunch of images in a folder. I want a macro to ask me how many recent images I would like to import. I will select something like "5". Then I would like each image to appear in a text box on 5 separate worksheets. These will be the 5 most recent images that were placed in the folder.

Is this possible? :)
 
Upvote 0
Xx7 said:
Works like a charm!! unbelievable.. thanks alot :)
Click to expand...

You're very welcome! Thanks for the feedback!

Quick follow-up question (different macro)...

If I have a bunch of images in a folder. I want a macro to ask me how many recent images I would like to import. I will select something like "5". Then I would like each image to appear in a text box on 5 separate worksheets. These will be the 5 most recent images that were placed in the folder.

Is this possible? :)
Click to expand...

Try...

Code: 
[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] test()

    [color=green]'Set up a reference to the Windows Script Host Object Model in the Visual Basic Editor[/color]
    [color=green]'Tools > References > Windows Script Host Object Model[/color]

    [color=darkblue]Dim[/color] objFSO [color=darkblue]As[/color] FileSystemObject
    [color=darkblue]Dim[/color] objFolder [color=darkblue]As[/color] Folder
    [color=darkblue]Dim[/color] objFile [color=darkblue]As[/color] File
    [color=darkblue]Dim[/color] wks [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] txtbox [color=darkblue]As[/color] Shape
    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] arrMyFiles() [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] Ans [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] Num [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] Cnt [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] j [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] temp1 [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] temp2 [color=darkblue]As[/color] [color=darkblue]Variant[/color]

    Ans = Application.InputBox(Prompt:="How many recent images would you like to import?", Title:="How man?", Type:=1)
    
    [color=darkblue]If[/color] Ans = [color=darkblue]False[/color] [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    
    [color=green]'Change the path to the folder accordingly[/color]
    strPath = "C:\Users\Domenic\Desktop\Test\"
    
    [color=darkblue]Set[/color] objFSO = CreateObject("Scripting.FileSystemObject")
    
    [color=darkblue]Set[/color] objFolder = objFSO.GetFolder(strPath)
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] objFile [color=darkblue]In[/color] objFolder.Files
        Cnt = Cnt + 1
        [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] arrMyFiles(1 [color=darkblue]To[/color] 2, 1 [color=darkblue]To[/color] Cnt)
        arrMyFiles(1, Cnt) = objFile.DateCreated
        arrMyFiles(2, Cnt) = objFile.Path
    [color=darkblue]Next[/color] objFile
    
    [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](arrMyFiles, 2) - 1
        [color=darkblue]For[/color] j = i + 1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](arrMyFiles, 2)
            [color=darkblue]If[/color] arrMyFiles(1, i) < arrMyFiles(1, j) [color=darkblue]Then[/color]
                temp1 = arrMyFiles(1, j)
                temp2 = arrMyFiles(2, j)
                arrMyFiles(1, j) = arrMyFiles(1, i)
                arrMyFiles(2, j) = arrMyFiles(2, i)
                arrMyFiles(1, i) = temp1
                arrMyFiles(2, i) = temp2
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] j
    [color=darkblue]Next[/color] i
    
    [color=darkblue]If[/color] Ans > [color=darkblue]UBound[/color](arrMyFiles, 2) [color=darkblue]Then[/color]
        Num = [color=darkblue]UBound[/color](arrMyFiles, 2)
    [color=darkblue]Else[/color]
        Num = Ans
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
    [color=darkblue]For[/color] i = 1 To Num
        [color=darkblue]Set[/color] wks = Worksheets.Add(before:=Worksheets(i))
        [color=darkblue]Set[/color] txtbox = wks.Shapes.AddTextbox(msoTextOrientationHorizontal, 195, 63, 292.5, 207)
        [color=darkblue]With[/color] txtbox.Fill
            .Visible = msoTrue
            .PresetTextured msoTexturePapyrus
            .TextureTile = msoTrue
            .TextureOffsetX = 0
            .TextureOffsetY = 0
            .TextureHorizontalScale = 1
            .TextureVerticalScale = 1
            .TextureAlignment = msoTextureTopLeft
            .UserPicture arrMyFiles(2, i)
        [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]Next[/color] i
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]
 
Upvote 0
You must log in or register to reply here.

Similar threads

drom
  • Solved
Fill a SmartArtLayouts with a existing picture
Replies
1
Views
714
Domenic
D
M
  • Question Question
Insert Image to shape
Replies
2
Views
2K
MarkOW
M
R
  • Question Question
VBA insert picture as fill
Replies
6
Views
15K
Boechat
B
N
  • Question Question
Macro to insert a preformatted, pre-populated text box [Excel 2010]
Replies
2
Views
2K
Nebulous
N
B
  • Question Question
Macro to insert comment with image
Replies
4
Views
2K
VBA Geek
VBA Geek

Forum statistics

Threads
1,224,583
Messages
6,179,678
Members
452,937
Latest member
Bhg1984

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top