Insert Random Image From Folder Of Images

[Dustout]

I frequently print off notes in word for co-workers and usually in these
notes i will included a random Dilbert comic from my folder of dilbert
comics. I was wondering if there was a feature within word that would
allow me to specify a folder or a range of images and then it would
select a random one from that set each time i print. I would imagine
that this could be done via a image randomizer from the internet and a
link to my word document. However i was hoping that there would be a
function within word that would fulfill this purpose.

Thanks

 

[Doug Robbins - Word MVP]

Word does not have such a function built into it. It would however be
possible to do it by the use of some VBA code.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[Graham Mayor]

I love odd puzzles like this on a quiet morning

The following macro should do the trick. Put your cursor in the document
where you want the image to appear and run the macro. This will place a
randomly chosen GIF image from the folder selected from the macro dialog at
the cursor and print the document. Each time the macro is run subsequently
on that document another random image from the folder will replace the
original image and reprint the document.

If your images are in a different format then change the 2 references to
*.gif in the macro to whatever alternative compatible graphics format
extension you have.

Sub PrintWithRandomImage()
Dim strFileName As String
Dim strPath As String
Dim oDoc As Document
Dim iCount, jCount As Long
Dim fDialog As FileDialog
Dim oBM As Bookmarks
Dim vBM As Variant
Dim rImage As Range
Dim bExists As Boolean
Set oBM = ActiveDocument.Bookmarks
bExists = False
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , _
"List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" _
Then strPath = strPath + "\"
End With
strFileName = Dir$(strPath & "*.gif")
iCount = 0
While Len(strFileName) <> 0
iCount = iCount + 1
strFileName = Dir$()
Wend
iItem = Int((iCount * Rnd) + 1)
strFileName = Dir$(strPath & "*.gif")
jCount = 0
While Len(strFileName) <> 0
jCount = jCount + 1
If jCount = iItem Then
For Each vBM In oBM
If vBM.name = "Dilbert1" Then
bExists = True
Exit For
End If
Next vBM
If bExists = False Then
Selection.Bookmarks.Add "Dilbert1"
End If
Set rImage = ActiveDocument.Bookmarks("Dilbert1").Range
rImage.Text = ""
rImage.InlineShapes.AddPicture (strPath & strFileName)
rImage.End = rImage.End + 1
ActiveDocument.Bookmarks.Add "Dilbert1", rImage
End If
strFileName = Dir$()
Wend
ActiveDocument.PrintOut
End Sub


http://www.gmayor.com/installing_macro.htm

If your images are always in the same folder, you can avoid the popup dialog
by fixing the folder location in the line indicated below

Sub PrintWithRandomGIF()
Dim strFileName As String
Dim strPath As String
Dim oDoc As Document
Dim iCount, jCount As Long
Dim oBM As Bookmarks
Dim vBM As Variant
Dim rImage As Range
Dim bExists As Boolean
Set oBM = ActiveDocument.Bookmarks
bExists = False
'+++++++++++++++++++++++++
strPath = "R:\Pictures\GIFs\"
'+++++++++++++++++++++++++
strFileName = Dir$(strPath & "*.gif")
iCount = 0
While Len(strFileName) <> 0
iCount = iCount + 1
strFileName = Dir$()
Wend
iItem = Int((iCount * Rnd) + 1)
strFileName = Dir$(strPath & "*.gif")
jCount = 0
While Len(strFileName) <> 0
jCount = jCount + 1
If jCount = iItem Then
For Each vBM In oBM
If vBM.name = "Dilbert1" Then
bExists = True
Exit For
End If
Next vBM
If bExists = False Then
Selection.Bookmarks.Add "Dilbert1"
End If
Set rImage = ActiveDocument.Bookmarks("Dilbert1").Range
rImage.Text = ""
rImage.InlineShapes.AddPicture (strPath & strFileName)
rImage.End = rImage.End + 1
ActiveDocument.Bookmarks.Add "Dilbert1", rImage
End If
strFileName = Dir$()
Wend
ActiveDocument.PrintOut
End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>