Consulting

Results 1 to 5 of 5

Thread: pictures not going to bookmark location when .dotm file is opened by double click ?

  1. #1

    pictures not going to bookmark location when .dotm file is opened by double click ?

    Hello all!

    I have a document with bookmark 'pretestpics' on page 4 where i would like to bulk insert my photos in table.
    I have the code such that whenever i open the .dotm file , i will get pop ups of userforms to fill data.
    ie sub document_new()
    userform1.show
    userform2.show

    'and so on and so forth
    end sub

    When i right click on the .dotm document and open it , i can run the userform and the pictures will go to the bookmark location.
    However, when i double click on the .dotm document and the userforms pop up and i select the pics, they will not go to my bookmark but go to the very beginning of the document. How can i fix this ? does it have anything to do with inlineshapes and shapes ? I would like the pics to go to the bookmark location.
    here is the code . I have also attached the zip file which contains the .dotm file. Please take a look at userform3 , insert pretest pictures button code .
    here it is -




    Private Sub CommandButton1_Click()
    
    Application.ScreenUpdating = False
    Dim i As Long, j As Long, c As Long, r As Long, NumCols As Long
    Dim oTbl As Table, TblWdth As Single, StrTxt As String, RwHght As Single
    On Error GoTo ErrExit
    NumCols = 3
    RwHght = CSng(3.8)
    On Error GoTo 0
    'Select and insert the Pics
    With Application.FileDialog(msoFileDialogFilePicker)
      .Title = "Select image files and click OK"
      .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
      .FilterIndex = 2
      .AllowMultiSelect = True
      If .Show = -1 Then
        'Add a 3-row by NumCols-column table to take the images
        Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=2, NumColumns:=NumCols)
        Dim orng As Word.Range
        Set ornge = ActiveDocument.Range.Bookmarks("pretestpics").Range
        ActiveDocument.Bookmarks.Add "pretestpics", oTbl.Range
        With ActiveDocument.PageSetup
          TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
        End With
        With oTbl
          .Borders.Enable = True
          .AutoFitBehavior (wdAutoFitFixed)
          .Columns.Width = InchesToPoints(2.2)
        End With
        CaptionLabels.Add Name:="Picture"
        For i = 1 To .SelectedItems.Count Step NumCols
          r = ((i + 1) / NumCols + 1) * 2 - 1
          'Format the rows
          Call FormatRows3(oTbl, r, RwHght)
          For c = 1 To NumCols
            j = j + 1
            'Insert the Picture
            ActiveDocument.InlineShapes.AddPicture _
              FileName:=.SelectedItems(j), LinkToFile:=False, _
              SaveWithDocument:=True, Range:=oTbl.Cell(r, c).Range
    
            ' is the problem here? do i need to convert inlineshapes to shapes ? how to do it?
            'Get the Image name for the Caption
            With oTbl.Cell(r - 1, c).Range
              .InsertBefore vbCr
              .Characters.First.InsertCaption _
                Label:="Picture", Title:=StrTxt, _
                Position:=wdCaptionPositionBelow, ExcludeLabel:=False
              .Characters.First = vbNullString
              .Characters.Last.Previous = vbNullString
            End With
            'Exit when we're done
            If j = .SelectedItems.Count Then Exit For
          Next
          'Add extra rows as needed
          If j < .SelectedItems.Count Then
            oTbl.Rows.Add
            oTbl.Rows.Add
          End If
        Next
      Else
      End If
    End With
    ErrExit:
    Application.ScreenUpdating = True
    End Sub
    '
    Sub FormatRows3(oTbl As Table, x As Long, Hght As Single)
    With oTbl
      With .Rows(x - 1)
        .Height = CentimetersToPoints(0.5)
        .HeightRule = wdRowHeightExactly
        .Shading.BackgroundPatternColor = wdColorBlack
    
        With .Range
          .Style = "Normal"
          With .ParagraphFormat
            .SpaceBefore = 0
            .SpaceAfter = 0
          End With
        End With
      End With
      With .Rows(x)
        .Height = CentimetersToPoints(Hght)
        .HeightRule = wdRowHeightExactly
        With .Range
          .Style = "Normal"
          With .ParagraphFormat
            .SpaceBefore = 0
            .SpaceAfter = 0
          End With
        End With
      End With
      End With
    End Sub
    thank you so much for your help!
    Attached Files Attached Files
    Last edited by macropod; 09-06-2018 at 08:51 PM. Reason: Added code tags & formatting

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,585
    Location
    Take a look at what your code is doing here:
        Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=2, NumColumns:=NumCols)
        Dim orng As Word.Range
        Set ornge = ActiveDocument.Range.Bookmarks("pretestpics").Range
        ActiveDocument.Bookmarks.Add "pretestpics", oTbl.Range
    you say you already have the bookmark, but you're not using it as the location to insert the table. You're evidently not using Option Explicit, either, as you Dim orng but Set ornge (both of which are unnecessary, anyway, as is the next line).

    PS: When posting code, please post formatted code and use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  3. #3
    Dear mr edstein,
    Thank you very much for your reply. I am a noob when it comes to visual basic coding. I have copied the above code from some other post and have tweaked it a bit. To be honest I am not hundred percent sure I understand what you meant with your reply. I have no idea how to use option explicit command. I would greatly appreciate if you could help me solve this issue. I have also attached the zip file for your reference.
    Again, thank you very much for your help mr edstein.

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,585
    Location
    Quote Originally Posted by sarveshspace View Post
    I have copied the above code from some other post and have tweaked it a bit.
    Yes, I know - I wrote the underlying code.

    Put simply, replace:
        Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=2, NumColumns:=NumCols)Dim orng As Word.Range
        Set ornge = ActiveDocument.Range.Bookmarks("pretestpics").Range
        ActiveDocument.Bookmarks.Add "pretestpics", oTbl.Range
    with:
        With ActiveDocument
          Set oTbl = .Tables.Add(Range:=.Bookmarks("pretestpics").Range, NumRows:=2, NumColumns:=NumCols)
        End With
    Cheers
    Paul Edstein
    [MS MVP - Word]

  5. #5
    thank you very much! this solved the issue!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •