Re: Random image generator in Word 2003




Does this help you, i'm not that good on work but it seems to work ok:




VBA Code:
--------------------



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
Dim i As Long
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

Selection.Bookmarks.Add "Dilbert" & jCount

Set rImage = ActiveDocument.Bookmarks("Dilbert" & jCount).Range
rImage.Text = ""
rImage.InlineShapes.AddPicture (strPath & strFileName)
rImage.End = rImage.End + 1
ActiveDocument.Bookmarks.Add "Dilbert" & jCount, rImage

strFileName = Dir$()
Wend
ActiveDocument.PrintOut
End Sub


--------------------






ade670;726548 Wrote:

Hi,

I have found some script on this site which generates a random image
via a VB macro.

I am struggling changing the code so that the first image remains and a
new image generates at the new cursor position - can anyone help??

Original script below:





VBA Code:
--------------------
>

>

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


--------------------





--
Simon Lloyd

Regards,
Simon Lloyd
'Microsoft Office Help' (http://www.thecodecage.com)
------------------------------------------------------------------------
Simon Lloyd's Profile: http://www.thecodecage.com/forumz/member.php?u=1
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=203613

http://www.thecodecage.com/forumz

.



Relevant Pages