Problém se vložením obrázku ve Wordu

Pokud narazíte na stejný problém jako já pomůže Vám tento článek.O co tedy vlastně šlo:
Potřeboval jsem do dokumentu vložit na určenou pozici obrázek.Zdánlivě banální věc, pokud by ovšem nebyl dokument tvořen z tabulek, do kterých je vloženo několik textových polí a do jednoho takového textového pole jsem obrázek potřeboval vložit.Bohužel jsem zjistil, že na mém počítači vše funguje tak jak má, ovšem na straně serveru (dokument se otvíral na požadavek z jiné aplikace, naplnil se dle požadavku daty a poté se zobrazil přes prohlížeč (IE5.5 a vyšší) uživateli.), se dokument nechoval tak jak má.Buď byl obrázek posunut někam jinam v dokumentu včtně textového pole, nebo měl jiné rozměry než původní obrázek.

Použil jsem proto záložku (Bookmark).I potom vše na mém počítači OK, na serveru nenašel word záložku.Nakonec (asi po 5 hodinách jsem na to přišel.) Problém byl v tom, že záložka byla v textovém poli, i když abych nelhal doteď nevím proč v mém počítači záložku najde a na jiném ne? :o))

Řešení tedy spočívalo v tom, říct wordu, kde má onu záložku hledat.

Předkládám tedy celé řešení tohoto problému:

Mám v dokumentu wordu Textové pole v něm jiné s názvem "Text Box 103".Do něho umístím záložku se jménem POLEOBRAZKU.

Do dokumentu vložím následující makra:

'Test funkcnosti
Sub LocalTest()
   FillBookMark "picture", "\\ibm2k\oraapp\Pics\50.tif"
   ActiveDocument.Application.Visible = True
End Sub

Sub VlozObrazek(ByVal PicName As Variant)
   On Error Resume Next
   Dim oo As InlineShape
   
   ActiveDocument.Shapes("Text Box 103").Select
   Selection.GoTo What:=wdGoToBookmark, Name:="POLEOBRAZKU"
  
   Set oo = Selection.InlineShapes.AddPicture(FileName:= _
      PicName, _
      LinkToFile:=False, SaveWithDocument:=True)
   
    'Uprava velikosti obr
    Do While oo.Height > 195
        oo.ScaleHeight = oo.ScaleHeight - 5
       oo.ScaleWidth = oo.ScaleHeight
       DoEvents
    Loop
    Do While oo.Width > 200
       oo.ScaleWidth = oo.ScaleWidth - 5
       oo.ScaleHeight = oo.ScaleWidth
       DoEvents
    Loop
End Sub


Private Function FillBookMark( _
             ByVal BookMarkName As String, _
             ByVal BookMarkValue As String)
  Dim oBmk As Bookmark
  Dim pBookMarkName As String
  Dim I
  
  On Error Resume Next
  Err.Clear
  
 'Osetreni pro obrazek
 If UCase(BookMarkName) = "PICTURE" Then
   'Application.Visible = True
   DoEvents
   VlozObrazek BookMarkValue
   'Application.Visible = False
   Exit Function
 End If
  
  'Potrebuju vlozit vicekrat jednu hodnotu pojmenuji
  ' zalozku s poradovym cislem
  'Cyklus pro stejna data bmk,bmk1,bmk2,bmk3,....
  For I = 0 To 8
    pBookMarkName = IIf(I > 0, BookMarkName & _
                    Trim(Str(I)), BookMarkName)
    Selection.GoTo What:=wdGoToBookmark, Name:=pBookMarkName
    If Err.Number <> 0 Then
      Err.Clear
      Exit For
      Exit Function
    End If
    With Selection
      .Delete unit:=wdCharacter, Count:=1
      .InsertAfter BookMarkValue
      .Bookmarks.Add Range:=Selection.Range, Name:=pBookMarkName
    End With
  Next
  Set oBmk = Nothing
End Function