Prev: Pasting pre-protected Building Block
Next: DocVariable wont work
From: ade670 on 18 May 2010 17:25

Simon Lloyd;726716 Wrote:
>
Ade, see my response above, like i said im not very well up on Word but
it seems to work.



Hi Simon,

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


--
ade670
------------------------------------------------------------------------
ade670's Profile: http://www.thecodecage.com/forumz/member.php?u=1881
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=203613

http://www.thecodecage.com/forumz

From: Simon Lloyd on 18 May 2010 19:15

Does this help any?



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

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






a
d
e
6
7
0
;
7
2
6
7
2
3

W
r
o
t
e
:


>
Hi Simon,

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

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

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

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 & "*.jpg")
iCount = 0
While Len(strFileName) <> 0
iCount = iCount + 1
strFileName = Dir$()
Wend
iItem = Int((iCount * Rnd) + 1)
strFileName = Dir$(strPath & "*.jpg")
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.Save
End Sub

Ade

*------------------------------- posted before receiving a reply after
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 folder
name etc

Ade


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

From: Doug Robbins - Word MVP on 18 May 2010 21:32
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

"ade670" <ade670.4b6etl(a)thecodecage.com> wrote in message
news:ade670.4b6etl(a)thecodecage.com...
>
> Doug Robbins - Word MVP;726709 Wrote:
>>
> 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
>>
>> "ade670" <ade670.4b67j2(a)thecodecage.com> wrote in message
>> news:ade670.4b67j2(a)thecodecage.com...
>> >
>> > 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:
>> >
>> > 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
>> >
>> >
>> > --
>> > ade670
>> >
> ------------------------------------------------------------------------
>> > ade670's Profile:
> http://www.thecodecage.com/forumz/member.php?u=1881
>> > View this thread:
>> > 'Random image generator in Word 2003 - The Code Cage Forums'
> (http://www.thecodecage.com/forumz/showthread.php?t=203613)
>> >
>> > 'Microsoft Office Help - Microsoft Office Discussion - Excel VBA
> Programming - Access Programming' (http://www.thecodecage.com/forumz)
>> >
>
>
>
> 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
>
>
> --
> ade670
> ------------------------------------------------------------------------
> ade670's Profile: http://www.thecodecage.com/forumz/member.php?u=1881
> View this thread:
> http://www.thecodecage.com/forumz/showthread.php?t=203613
>
> http://www.thecodecage.com/forumz
>
From: ade670 on 18 May 2010 21:35

Simon Lloyd;726812 Wrote:
>
Does this help any?
>
>
>



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
>

--------------------
>
>





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


--
ade670
------------------------------------------------------------------------
ade670's Profile: http://www.thecodecage.com/forumz/member.php?u=1881
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=203613

http://www.thecodecage.com/forumz

From: Simon Lloyd on 18 May 2010 21:37

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.



a
d
e
6
7
0
;
7
2
6
8
5
8

W
r
o
t
e
:


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

First  |  Prev  |  Next  |  Last
Pages: 1 2 3
Prev: Pasting pre-protected Building Block
Next: DocVariable wont work