Random image generator in Word 2003

A

ade670

Hi,

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

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

Original script below:

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
 
D

Doug Robbins - Word MVP

In addition to moving the .End of the rImage Range, you also need to move
the its .Start before recreating the bookmark.

--
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
 
S

Simon Lloyd

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



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


Sub PrintWithRandomImage(
Dim strFileName As Strin
Dim strPath As Strin
Dim oDoc As Documen
Dim iCount, jCount As Lon
Dim fDialog As FileDialo
Dim oBM As Bookmark
Dim vBM As Varian
Dim rImage As Rang
Dim bExists As Boolea
Dim i As Lon
Set oBM = ActiveDocument.Bookmark
bExists = Fals
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker
With fDialo
.Title = "Select folder and click OK
.AllowMultiSelect = Fals
.InitialView = msoFileDialogViewLis
If .Show <> -1 The
MsgBox "Cancelled By User", ,
"List Folder Contents
Exit Su
End I
strPath = fDialog.SelectedItems.Item(1
If Right(strPath, 1) <> "\"
Then strPath = strPath + "\
End Wit
strFileName = Dir$(strPath & "*.gif"
iCount =
While Len(strFileName) <>
iCount = iCount +
strFileName = Dir$(
Wen
iItem = Int((iCount * Rnd) + 1
strFileName = Dir$(strPath & "*.gif"
jCount =
While Len(strFileName) <>
jCount = jCount +

Selection.Bookmarks.Add "Dilbert" & jCoun

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

strFileName = Dir$(
Wen
ActiveDocument.PrintOu
End Su

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





Hi

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

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

Original script below

VBA Code:
--------------------
Sub PrintWithRandomImage(
Dim strFileName As Strin
Dim strPath As Strin
Dim oDoc As Documen
Dim iCount, jCount As Lon
Dim fDialog As FileDialo
Dim oBM As Bookmark
Dim vBM As Varian
Dim rImage As Rang
Dim bExists As Boolea
Set oBM = ActiveDocument.Bookmark
bExists = Fals
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker
With fDialo
.Title = "Select folder and click OK
.AllowMultiSelect = Fals
.InitialView = msoFileDialogViewLis
If .Show <> -1 The
MsgBox "Cancelled By User", ,
"List Folder Contents
Exit Su
End I
strPath = fDialog.SelectedItems.Item(1
If Right(strPath, 1) <> "\"
Then strPath = strPath + "\
End Wit
strFileName = Dir$(strPath & "*.gif"
iCount =
While Len(strFileName) <>
iCount = iCount +
strFileName = Dir$(
Wen
iItem = Int((iCount * Rnd) + 1
strFileName = Dir$(strPath & "*.gif"
jCount =
While Len(strFileName) <>
jCount = jCount +
If jCount = iItem The
For Each vBM In oB
If vBM.name = "Dilbert1" The
bExists = Tru
Exit Fo
End I
Next vB
If bExists = False The
Selection.Bookmarks.Add "Dilbert1
End I
Set rImage = ActiveDocument.Bookmarks("Dilbert1").Rang
rImage.Text = "
rImage.InlineShapes.AddPicture (strPath & strFileName
rImage.End = rImage.End +
ActiveDocument.Bookmarks.Add "Dilbert1", rImag
End I
strFileName = Dir$(
Wen
ActiveDocument.PrintOu
End Su

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

--
Simon Lloyd

Regards
Simon Lloy
'Microsoft Office Help' (http://www.thecodecage.com)
 
A

ade670

In addition to moving the .End of the rImage Range, you also need t
move
the its .Start before recreating the bookmark.

--
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


------------------------------------------------------------------------
Click to expand...



Doug,

Its a big ask, but could you alter you code to reflect the above - i'
really new to this and I have been hunting around for a process t
generate a basic question paper - I was thinking of storing th
questions as images for sake of ease

ade
 
S

Simon Lloyd

Ade, see my response above, like i said im not very well up on Word but
it seems to work.


Doug,

Its a big ask, but could you alter you code to reflect the above - i'm
really new to this and I have been hunting around for a process to
generate a basic question paper - I was thinking of storing the
questions as images for sake of ease

ade


--
Simon Lloyd

Regards,
Simon Lloyd
'Microsoft Office Help' (http://www.thecodecage.com)
 
A

ade670

Ade, see my response above, like i said im not very well up on Word bu
it seems to work.



Hi Simon,

Your script places all of the images within the folder I think!
 
S

Simon Lloyd

Does this help any



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


Sub PrintWithRandomImage(
Dim strFileName As Strin
Dim strPath As Strin
Dim oDoc As Documen
Dim iCount, jCount As Lon
Dim fDialog As FileDialo
Dim oBM As Bookmark
Dim vBM As Varian
Dim rImage As Rang
Dim bExists As Boolea
Dim ib As Long, i As Lon
Set oBM = ActiveDocument.Bookmark
bExists = Fals
ib = InputBox("Enter number of questions needed", "Question count"
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker
For i = 1 To ib Step
With fDialo
.Title = "Select folder and click OK
.AllowMultiSelect = Fals
.InitialView = msoFileDialogViewLis
If .Show <> -1 The
MsgBox "Cancelled By User", ,
"List Folder Contents
Exit Su
End I
strPath = fDialog.SelectedItems.Item(1
If Right(strPath, 1) <> "\"
Then strPath = strPath + "\
End Wit
strFileName = Dir$(strPath & "*.gif"
iCount =
While Len(strFileName) <>
iCount = iCount +
strFileName = Dir$(
Wen
iItem = Int((iCount * Rnd) + 1
strFileName = Dir$(strPath & "*.gif"
jCount =
While Len(strFileName) <>
jCount = jCount +
If jCount = iItem The
For Each vBM In oB
If vBM.Name = "Dilbert" & jCount The
bExists = Tru
Exit Fo
End I
Next vB
If bExists = False The
Selection.Bookmarks.Add "Dilbert" & jCoun
End I
Set rImage = ActiveDocument.Bookmarks("Dilbert" & jCount).Rang
rImage.Text = "
rImage.InlineShapes.AddPicture (strPath & strFileName
rImage.End = rImage.End +
ActiveDocument.Bookmarks.Add "Dilbert" & jCount, rImag
End I
strFileName = Dir$(
Wen
Next
ActiveDocument.PrintOu
End Su

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






Hi Simon

Your script places all of the images within the folder I think

*------------------------------- posted before receiving a reply afte
18 minutes of original post -------------------------------

With the script as per below ( i have altered the save and change
.jpg) all of the contents of the folder print out on the screen - thi
is a little frustrating !!!

Sub PrintWithRandomImage(
Dim strFileName As Strin
Dim strPath As Strin
Dim oDoc As Documen
Dim iCount, jCount As Lon
Dim fDialog As FileDialo
Dim oBM As Bookmark
Dim vBM As Varian
Dim rImage As Rang
Dim bExists As Boolea
Dim i As Lon
Set oBM = ActiveDocument.Bookmark
bExists = Fals
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker
With fDialo
.Title = "Select folder and click OK
.AllowMultiSelect = Fals
.InitialView = msoFileDialogViewLis
If .Show <> -1 The
MsgBox "Cancelled By User", ,
"List Folder Contents
Exit Su
End I
strPath = fDialog.SelectedItems.Item(1
If Right(strPath, 1) <> "\"
Then strPath = strPath + "\
End Wit
strFileName = Dir$(strPath & "*.jpg"
iCount =
While Len(strFileName) <>
iCount = iCount +
strFileName = Dir$(
Wen
iItem = Int((iCount * Rnd) + 1
strFileName = Dir$(strPath & "*.jpg"
jCount =
While Len(strFileName) <>
jCount = jCount +

Selection.Bookmarks.Add "Dilbert" & jCoun

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

strFileName = Dir$(
Wen
ActiveDocument.Sav
End Su

Ad

*------------------------------- posted before receiving a reply afte
22 minutes of original post -------------------------------

Hi Simon

Any chance you could take a look at the script once more mate

It prints everything out for me and I have tried changing the folde
name et

Ade


--
Simon Lloyd

Regards
Simon Lloy
'Microsoft Office Help' (http://www.thecodecage.com)
 
D

Doug Robbins - Word MVP

The following will insert a carriage return after the picture and then
insert a bookmark into the new paragraph. It seems to me that you should
probably be using "Dilbert" & jcount instead of "Dilbert1" as the bookmark
name in all of the places where you use "Dilbert1"

Sub PrintWithRandomImage()
Set rimage = ActiveDocument.Bookmarks("Dilbert" & jcount).Range
rimage.Text = ""
rimage.InlineShapes.AddPicture "C:\Users\Doug\Pictures\clv12.jpg"
rimage.End = rimage.End + 1
rimage.Collapse wdCollapseEnd
rimage.InsertAfter vbCr
rimage.End = rimage.End + 1
rimage.Collapse wdCollapseEnd
ActiveDocument.Bookmarks.Add "Dilbert" & jcount, rimage

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 If
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("Dilbert" & jcount).Range
rimage.Text = ""
rimage.InlineShapes.AddPicture strPath & strFileName
rimage.End = rimage.End + 1
rimage.Collapse wdCollapseEnd
rimage.InsertAfter vbCr
rimage.End = rimage.End + 1
rimage.Collapse wdCollapseEnd
ActiveDocument.Bookmarks.Add "Dilbert1", rImage
End If
strFileName = Dir$()
Wend
ActiveDocument.PrintOut
End Sub


--
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
 
A

ade670

Simon said:
Does this help any?
Click to expand...

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 ib As Long, i As Long
Set oBM = ActiveDocument.Bookmarks
bExists = False
ib = InputBox("Enter number of questions needed", "Question count")
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
For i = 1 To ib Step 1
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 = "Dilbert" & jCount Then
bExists = True
Exit For
End If
Next vBM
If bExists = False Then
Selection.Bookmarks.Add "Dilbert" & jCount
End If
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
End If
strFileName = Dir$()
Wend
Next i
ActiveDocument.PrintOut
End Sub
--------------------
Click to expand...




Hi Simon,

It works one or two times and then reverts to single image - not sur
what you are seeing - - if I may - can I send you the actual word do
that I am using ???

Thanks for all your help

Ade
 
S

Simon Lloyd

Sure

Attachments.

To upload a document, click reply then add your few words, scroll down
past the submit button and you will see the Manage Attachments button,
this is where you get to add files for upload, if you have any trouble
please use this link or the one at the bottom of the
any page.



Hi Simon,

It works one or two times and then reverts to single image - not sure
what you are seeing - - if I may - can I send you the actual word doc
that I am using ???

Thanks for all your help

Ade



Attachments.

To upload a workbook, click reply then add your few words, scroll down
past the submit button and you will see the Manage Attachments button,
this is where you get to add files for upload, if you have any trouble
please use this link or the one at the bottom of the
any page.


--
Simon Lloyd

Regards,
Simon Lloyd
'Microsoft Office Help' (http://www.thecodecage.com)
 
A

ade670

Simon said:
Sure

Attachments.

To upload a document, click reply then add your few words, scroll dow
Click to expand...
past the submit button and you will see the Manage Attachments button
this is where you get to add files for upload, if you have any troubl
please use this link or the one at the bottom of th
any page.
Attachments.

To upload a workbook, click reply then add your few words, scroll dow
Click to expand...
past the submit button and you will see the Manage Attachments button
this is where you get to add files for upload, if you have any troubl
please use this link or the one at the bottom of th
any page.


Guys,

I have attached my document with the macro enabled and a few words (an
the source code) in the main body - any help with this would b
amazing

Ade


+-------------------------------------------------------------------+
|Filename: Exampapercreator-withmacro.doc |
|Download: http://www.thecodecage.com/forumz/attachment.php?attachmentid=590|
+-------------------------------------------------------------------+
 
S

Simon Lloyd

In your example the code below worked fine!



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


Private Sub CommandButton1_Click()
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 = "Dilbert" & jCount Then
bExists = True
Exit For
End If
Next vBM
If bExists = False Then
Selection.Bookmarks.Add "Dilbert" & jCount
End If
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
End If
strFileName = Dir$()
Wend
ActiveDocument.PrintOut
End Sub
--------------------





Guys,

I have attached my document with the macro enabled and a few words (and
the source code) in the main body - any help with this would be amazing

Ade


--
Simon Lloyd

Regards,
Simon Lloyd
'Microsoft Office Help' (http://www.thecodecage.com)
 
A

ade670

In your example the code below worked fine!
VBA Code:
--------------------Private Sub CommandButton1_Click()
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 = "Dilbert" & jCount Then
bExists = True
Exit For
End If
Next vBM
If bExists = False Then
Selection.Bookmarks.Add "Dilbert" & jCount
End If
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
End If
strFileName = Dir$()
Wend
ActiveDocument.PrintOut
End Sub --------------------
Click to expand...




Found out what it was - wait for it---- Inadvertently, I wa
deleting the booking "dilbert" from the word document - I have no
worked an example, wherby it adds at the given book marked, anchored t
the document - jeez,

Thanks for your help mate,

Ade
 
S

Simon Lloyd

You would be better off having all the text on an xlVeryHidde
worksheet and pick the text randomly from there. I'm not sure whethe
you can just read random words from a text file, i think you have t
GET all the text into excel then perfom a randomisation, so cut out th
middle man and store them in your workbook

When a worksheet is xlVeryHidden via VBA it can only be made visibl
via VBA and not through the menubar


Found out what it was - wait for it---- Inadvertently, I was deletin
the booking "dilbert" from the word document - I have now worked a
example, wherby it adds at the given book marked, anchored to th
document - jeez

Thanks for your help mate

Ad

*------------------------------- posted before receiving a reply afte
1 23 minutes of original post -------------------------------

Hi Simon

Thanks for your help on this - with bookmarks in place and usin
multiple command button this work

One final query, is it possible to alter the code so tha it displays
random word from a .txt document at a bookmark

- I am a music teacher and being able to generate a simple test whic
removes the headache of manually creating a new one each time is a rea
treat

Ade


--
Simon Lloyd

Regards
Simon Lloy
'Microsoft Office Help' (http://www.thecodecage.com)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Word macro that can call cells out of Excel for a find and replace 0
Batch Update problems... 2
Macro stuck in infinite Dir loop 5
Help Tweaking a Macro 1
Looking for suggestions how to make my functional but ugly hack jobcode elegant 5
Changing multiple word document templates 0
change macro to include subfolders 1
Dir() not working in MS Word 2016 in MAC system 0

Top