Option Explicit
Dim objWrdApp As Object
Dim objWrdDoco As Object
Dim zpath, zname, zdot, ss
 
 
Sub za160330m()
 
zpath = ThisWorkbook.Path + ""
zdot = zpath & "prikaz.docx"
zname = zpath & "www1.doc"
''On Error Resume Next
''Set objWrdApp = GetObject(, "Word.Application")
If objWrdApp Is Nothing Then
Set objWrdApp = CreateObject("Word.Application")
' Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path + "" + "prikaz.docx")
' Set objWrdDoc = objWrdApp.Documents.Add
objWrdApp.Visible = True
End If
Set objWrdDoco = objWrdApp.Documents.Open(zdot)
 
MREPL "vr_1", Range("c2").Value
MREPL "centr_1", Range("d2").Value
MREPL "sz_1", Range("e2").Value
MREPL "inv_1", Range("f2").Value
objWrdDoco.SaveAs zname
 
objWrdApp.Quit True
Set objWrdDoco = Nothing
Set objWrdApp = Nothing
 
Shell "winword.exe " & zname, vbMaximizedFocus
 
End Sub
Sub MREPL(N_WORD, N_EXCEL)
 objWrdDoco.Select
  With objWrdDoco.Range.Find
   If Len(N_WORD) > 0 Then
    .Text = "" & N_WORD & ""
    .Replacement.Text = "" & N_EXCEL
    .Execute Replace:=2
   End If
  End With
End Sub

Sub za()
    Dim objWrdApp As Object
    Dim objWrdDoc As Object
    On Error Resume Next
    Set objWrdApp = GetObject(, "Word.Application")
        If objWrdApp Is Nothing Then
            Set objWrdApp = CreateObject("Word.Application")
            Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path + "\" + "t.dot")
            objWrdApp.Visible = True
        End If
    Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path + "\" + "t.dot")
    Set objWrdDoc = Nothing
    Set objWrdApp = Nothing
    
End Sub

Set Rng = ActiveCell
  Pic = "C:\Users\aveng\Desktop\1.jpg"
  Set p = ActiveSheet.Shapes.AddPicture(Pic, msoFalse, msoCTrue, Rng.Left, Rng.Top, -1, -1)
  ratio = Rng.Width / p.Width
  p.ScaleWidth ratio, msoFalse
  p.ScaleHeight ratio, msoFalse

ActiveSheet.Shapes.AddPicture Filename:="C:\Users\aveng\Desktop\1.jpg", linktofile:=msoFalse, _
savewithdocument:=msoCTrue, Left:=0, Top:=0, Width:=-1, Height:=-1