Pegar imagen vectorial en archivo paint

[Visor]

Saludos amigos del foro

Me gustaría saber si se pueda hacer que una imagen vectorial se pueda pegar en un archivo paint, ya sea que este cerrado o abierto

Subo un archivo ejemplo para continuar el código. al abrir el archivo por favor dar click en el boton naranja, la imagen que se vea  en la hoja1 es la que quiero enviar al paint

Gracias por la ayuda que puedan darme

Enviar a paint.xlsm

[LeandroA]

Hola hay que guardar el shape como una imagen.png y luego llamar al paint con la ruta guardada.

no se cual es la idea pero cada vez que llamas a "traer picture" deberías eliminar el shape anterior, pero lo deje como estaba porque no se cual es tu idea.

 

Saludos.

Enviar a paint.xlsm

[Visor]

Estimado LeandroA gracias por tu gentil apoyo, he repetido muchas veces la macro y todo esta bien, efectivamente la imagen vectorial es para una firma en digital que incluye un texto que cambia según el documento que vaya a firmar. Si lo dejo así como un picture de excel se cualquiera lo puede manipular y quitar el texto, en cambio si lo copio de una imagen como es el caso de un  Paint seria mas difícil y ademas podría guardar la imagen de la firma referente al documento como un respaldo por si pueda volver a necesitarlo o para comparar por si se ofrezca a futuro; y como norma propia cada cierto tiempo eliminaría estos archivos.

Espero me haya hecho entender

Sin embargo una cosa mas, con las disculpas del caso. Como sabes los programas deben ser a prueba de error sobre todo humano. Se produce error si se hace click al boton "Enviar a Paint" cuando no exista imagen en B2 para esto es necesario colocar un, por ejemplo algo asi: if Hoja1.shape = " " Then Exit sub

Para que no se produzca el error, entonces cual seria el código para eso??

Te estoy muy agradecido por tu  generoso apoyo

 

[LeandroA]

Hola la verdad no entendi mucho, supongo que te referis a objetos insertados, si es asi se puede utilizar OLEObjects pero si o si tenes que crear un archivo para levantarlo, y toda modificación que hagas en el paint queda guardada en la imagen del objeto de excel.

Aquí están las dos Rutina una pasa de hoja2 a hoja1 y la otra activa el paint.

Sub CrearImagen()
    Dim sFile As String
    Dim ChartObj As Object
    Dim OleObj As OLEObject
    
    Application.ScreenUpdating = False
    If Hoja1.OLEObjects.Count > 0 Then Hoja1.OLEObjects(1).Delete  'Elimina el anterior (opcional)
    
    sFile = Environ("Temp") & "\Image.bmp"
    
    With Hoja2.Range("A1")
        .CopyPicture
        Set ChartObj = Hoja1.ChartObjects.Add(0, 0, .Width, .Height)
    End With
    
    ChartObj.Chart.Paste
    ChartObj.Chart.Export sFile, "bmp"
    ChartObj.Delete
    
    With Hoja1.Range("B2")
        Set OleObj = Hoja1.OLEObjects.Add(Filename:=sFile, Link:=False, Left:=.Left, Top:=.Top)
        OleObj.Name = [D1].Value
        OleObj.Width = .Width
        OleObj.Height = .Height
    End With
    
    Application.ScreenUpdating = True
End Sub


Sub AbrirImagenEnPaint()
    On Error Resume Next
    Hoja1.OLEObjects([D1].Value).Activate
End Sub

En cuanto a seguridad no creo que no aya método para que no se plagie la imagen.

Saludos.

[Visor]

Gracias LeandroA, con esta imagen sera mejor que mil palabras, Toma en cuenta que si desde el inicio lo creo como imagen no podría colocar texto al interior de la imagen vectorial (agrupada), luego de esto se debe asegurar que lo que se usara sera una imagen no sesagrupable sera como una foto que tiene pegado el texto en pixeles como lo hace le formato png o jpg o mapa de bits.

Con el anterior codigo me has ayudado a resolverlo, pero lo que sucede es que hay que evitar que cuando por error se pincha en el boton imagen se produzca error.

Espero tu comentario y muchas gracias por el aporte

 

[LeandroA]

hola si es por saber si existe o no el shape la opcion mas facil es un manejo de Error de lo contrario deberias recorrer la colecion de shapes en hoja1 y ver si exite algun que tenga ese nombre, pero en fin te paso el de manejo de error.

	Sub Copy()
    On Error GoTo ErrExit
    Dim sFile As String
    sFile = Environ("Temp") & "\Image.png"
    
    With Hoja1.Shapes([D1].Value)
        .CopyPicture
        Set chartobj = Hoja1.ChartObjects.Add(0, 0, .Width, .Height)
        chartobj.Chart.Paste
        chartobj.Chart.Export sFile, "png"
        chartobj.Delete
    End With
	    Shell "Mspaint.exe " & sFile, vbMaximizedFocus
ErrExit:
     
End Sub

[Visor]

Si,... ahora si funciona, quedo bien 

Te agradezco mucho, 

Tema solucionado