Añadir objeto OLE a fichero Word

        Dim vprov As String, vdir As String
        Dim miWord As New Word.Application
        Dim miPlantilla As String
        Dim miCarta As String
        Dim rutaCartas As String
        Dim rutabd As String
        Dim rutadoc As String
    'Guardamos el registro de trabajo
        If Me.Dirty Then Me.Dirty = False
    'mimodelo = producto
   
   
 
    'comprobamos si existen carpetas
        Dim vplantilla As String, vrutaarchivo As String, vdoc As String, vbd As String, vsituacion As String
        Dim micarpeta As String
        Dim miruta As String
        Dim cuenta
        Dim vreferencia As String, vidprop As String
        vplantilla = Application.CurrentProject.Path & "\plantillas"
crear:
    'Creamos la ruta de la plantilla
       
        vdoc = "presupuesto.dotx"
        miPlantilla = vplantilla & "\" & vdoc
    'Creamos la ruta donde guardar la carta
        rutadoc = Application.CurrentProject.Path & "\presupuestos"
        vrutaarchivo = "\" & Year(Now) & "\prueba_" & Format(Time, "hh-mm-ss") & ".docx"
        rutadoc = rutadoc & vrutaarchivo
    'Creamos una instancia de Word
     

   
      'miWord.Visible = True

 
    '********************************************** DATOS ****************************************************
   
   
    vNom = "pepe perez" 'InputBox("Nombre cliente:")
    vdir = "rue del percebe" 'InputBox("Direccion Cliente")
    vloc = "Santander" 'InputBox("Localidad cliente")
    vprov = "Cantabria" 'InputBox("Provincia cliente")
    vmod = "Presupuesto de " & mimodelo
    vmod1 = mimodelo
    vpvp = DSum("pvp", "tbl_temporal_acc", "id > 1")
    vcopias = Nz(DLookup("[Velocidad de impresión]", "datos_catalogo", "Modelo = '" & mimodelo & "'"), "")
   
    '*********************************sacar velocidad
recortacopias:
   
    a = Len(vcopias)
    b = InStr(1, vcopias, ";")
    c = InStr(1, vcopias, mimodelo1)
    If b > c Then
    vcopias = Mid(vcopias, 1, b - 1)
    Else
    vcopias = Right(vcopias, a - b)
    GoTo recortacopias
    End If
   
    vfunciones = Nz(DLookup("[funciones principales]", "datos_catalogo", "[Modelo] = '" & mimodelo & "'"), "")
    vtipoequipo = Nz(DLookup("[tipo de equipo]", "datos_catalogo", "Modelo = '" & mimodelo & "'"), "")
    vformatopapel = Nz(DLookup("[tamaños de papel]", "datos_catalogo", "Modelo = '" & mimodelo & "'"), "")
    vtipoalimentador = Nz(DLookup("[tipo de estándar]", "datos_catalogo", "Modelo = '" & mimodelo & "'"), "")
    'vdoblecara = Nz(DLookup("[Unidad de doble cara]", "datos_catalogo", "Modelo = '" & mimodelo & "'"), "Si")
    vcinterface = Nz(DLookup("[conexión de interfaz]", "datos_catalogo", "Modelo = '" & mimodelo & "'"), "Si")
    vimpmovil = Nz(DLookup("[Impresión desde móviles y nube]", "datos_catalogo", "Modelo = '" & mimodelo & "'"), "Si")
    vtpapel = Nz(DLookup("[Tamaños de papel]", "datos_catalogo", "Modelo = '" & mimodelo & "'"), "Si")
    vgpapel = Nz(DLookup("[Gramajes de papel]", "datos_catalogo", "Modelo = '" & mimodelo & "'"), "Si")
    '********************************************** Rellena plantilla**************************************************
    Dim imagen1 As String
 
    Set db = Nothing
  
    imagen1 = Application.CurrentProject.Path & "\imagenes\" & mimodelo & ".jpg"
     'Rellenamos los marcadores del Word con la información
        Set miWord = CreateObject("Word.Application")
            miWord.Documents.Add miPlantilla
             miWord.Visible = True
          If Me.Imagen.Picture <> "" Or Not IsNull(Me.Imagen.Picture) Then
            miWord.ActiveDocument.Shapes("imagen").Select
            miWord.Selection.Range.Select
            miWord.Selection.InlineShapes.AddPicture FileName:=imagen1, linktofile:=False, savewithdocument:=True
        End If
        With miWord.ActiveDocument.Bookmarks
            '.Item("imagen").Range.Text = imagen1
            .Item("nombre1").Range.Text = vNom & " "
            .Item("nombre2").Range.Text = vNom & " "
            .Item("direccion1").Range.Text = " " & vdir & " "
            .Item("direccion2").Range.Text = " " & vdir & " "
            .Item("ciudad1").Range.Text = " " & vloc & " "
            .Item("ciudad2").Range.Text = " " & vloc & " "
            .Item("provincia1").Range.Text = " " & vprov & " "
            .Item("provincia2").Range.Text = " " & vprov & " "
            .Item("velocidad").Range.Text = " " & vcopias & " "
            .Item("vfunciones").Range.Text = " " & vfunciones & " "
            .Item("vdoblecara").Range.Text = " " & vdoblecara & " "
            .Item("vtipoalimentador").Range.Text = " " & vtipoalimentador & " "
            .Item("vcinterface").Range.Text = " " & vcinterface & " "
            .Item("vimpmovil").Range.Text = " " & vimpmovil & " "
            .Item("vtpapel").Range.Text = " " & vtpapel & " "
            .Item("vgpapel").Range.Text = " " & vgpapel & " "
            .Item("modelo").Range.Text = vmod
            .Item("modelo0").Range.Text = vmod1
            .Item("modelo1").Range.Text = vmod1
            .Item("modelo2").Range.Text = vmod1
            .Item("precio").Range.Text = vpvp
       End With
fin:
    'Creamos el archivo final
    miCarta = rutadoc
    miWord.ActiveDocument.SaveAs FileName:=miCarta, FileFormat:=wdFormatDocumentDefault
    miWord.Quit
    Set miWord = Nothing
  'Lanzamos un mensaje de aviso
    MsgBox "El presupuesto se ha generado correctamente", vbInformation, "OK"
    Set miWord = CreateObject("Word.Application")
    miWord.Documents.Open ("" & miCarta & "")


Editado por 01loko - 11/Marzo/2020 a las 20:36

Hola.

https://docs.microsoft.com/es-es/office/client-developer/visio/change-the-name-and-view-the-id-of-a-shape

Buenos dias y gracias de nuevo.
Ya conseguí crear el cuadro de texto, lo he dejado con el mismo nombre "imagen"

Mi código es el siguiente:

Private Sub cmdWORD_Click()
    Dim miWord As New Word.Application
    Dim miPlantilla As String
    miPlantilla = "D:\TALLER\Productos.dotx"

    Set miWord = CreateObject("Word.Application")
    miWord.Documents.Add miPlantilla
    miWord.Visible = True

    'Declaramos las variables para rellenar el documento de Word
    Dim vDia, vMes, vAño As String

    vDiaComp = Day(Me.vHechoEn)
    vMesComp = UCase(MonthName(Month(Me.vHechoEn)))
    vAñoComp = Year(Me.vHechoEn)

    With miWord.ActiveDocument.Bookmarks
        .Item("WtxtIDPieza").Range.Text = [P_IDPieza]
        .Item("WtxtRefPieza").Range.Text = [P_RefPieza]
        .Item("WtxtNomPieza").Range.Text = [P_NomPieza]
        .Item("WtxtvDiaComp").Range.Text = vDiaComp
        .Item("WtxtvMesComp").Range.Text = vMesComp
        .Item("WtxtvAñoComp").Range.Text = vAñoComp
        ............
    End With
End Sub

Viendo tu código, creo que las líneas que debo añadir son:
           
miWord.ActiveDocument.Shapes("imagen").Select
miWord.Selection.Range.Select
miWord.Selection.InlineShapes.AddPicture FileName:=Imagen1, linktofile:=False, savewithdocument:=True

Pero tu en estas líneas haces referencia a un fichero (Imagen1), el cual yo no utilizo.
Con todo esto, y teniendo en cuenta que el campo de la tabla que tiene la imagen se llama CampOLE, y el nombre del cuadro de texto de Word se llama "imagen", de que manera encajo el código?

Saludos.