Random image generator in Word 2003
in [Word VBA]
|
From: ade670 on 18 May 2010 14:39 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: http://www.thecodecage.com/forumz/showthread.php?t=203613 http://www.thecodecage.com/forumz
From: Doug Robbins - Word MVP on 18 May 2010 17:09 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: > http://www.thecodecage.com/forumz/showthread.php?t=203613 > > http://www.thecodecage.com/forumz >
From: Simon Lloyd on 18 May 2010 17:15 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 -------------------- a d e 6 7 0 ; 7 2 6 5 4 8 W r o t e : > 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
From: ade670 on 18 May 2010 17:16 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: Simon Lloyd on 18 May 2010 17:17
Ade, see my response above, like i said im not very well up on Word but it seems to work. a d e 6 7 0 ; 7 2 6 7 1 4 W r o t e : > 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) ------------------------------------------------------------------------ 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 |