Estimados amigos,

Acudo a ustedes nuevamente en su ayuda, espero me la puedan brindar.

Necesito crear una macro que me genere una imagen en jpg desde una hoja y la guarde en una carpeta determinada que se encuentra en el escritorio, en donde creará otra carpeta con el nombre de la imagen y dentro de esta pegue la imagen en jpg con el mismo nombre, es decir:

1.- Al dar click en un botón, genere la imagen en .jpg

2.- cree una carpeta en la carpeta llamada "CARPETAS" ubicada en el escritorio, con el nombre que esta en la celda "A1"

3.- analice si la carpeta existe, si esta no existe debe crear la carpeta pero si ya existe enviar un mensaje que diga "LA CARPETA YA EXISTE" y no hacer nada.

4.- Pegar la imagen en .jpg con el mismo nombre de la carpeta dentro de la misma.

He estada investigando temas similares pero no hay nada parecido y lo poco que he avanzado es crear la carpeta dentro de "CARPETAS" pero no se como pegar el archivo de imagen con el nombre de la misma carpeta.

adjunto el archivo con el que pude crear la carpeta con el nombre de la celda A1 en la carpeta "CARPETA" del escritorio

el codigo con el que estoy intentando crear el jpg es el siguiente:

Public Sub GuardarImagen()

    Dim choObj As ChartObject, chGráf As Chart, ptImagen As Object

    Dim blnGuardado As Boolean

    Dim fnameJPG As String


    Worksheets("AGOSTO").Range("A1:P44").CopyPicture appearance:=xlScreen, Format:=xlPicture


    Set choObj = ActiveSheet.ChartObjects.Add(0, 0, 800, 600)

    Set chGráf = choObj.Chart


    choObj.Activate

    chGráf.ChartArea.Select

    chGráf.Paste

    Set ptImagen = chGráf.Pictures(1)


    ptImagen.Left = 0

    ptImagen.Top = 0


    choObj.Border.LineStyle = xlNone

    choObj.Width = ptImagen.Width + 7

    choObj.Height = ptImagen.Height + 7


    fnameJPG = Range("A1").Value


    blnGuardado = chGráf.Export(Filename:="C:" \ CARPETAS \ " & fnameJPG & " \ " & fnameJPG & .JPG", filtername:="JPG")

    If Not blnGuardado Then MsgBox prompt:="Problemas al guardar la imagen.", Buttons:=vbOKOnly + vbExclamation

    choObj.Delete


    Set choObj = Nothing

    Set chGráf = Nothing

    Set ptImagen = Nothing

End Sub


[/CODE]

pero este código me da un error (9) y aveces un error (13)

Espero sus prontas respuestas, y anticipo mis agradecimientos

PASAR IMAGENES.rar

Estimados amigos he solucionado mi problema con el siguiente código:

Sub Crear_Carpeta()

    Dim obj  As Object      

    Dim car  As Variant     

    Dim pds  As Variant     



        If Sheets("Cedula").Range("A1") = Empty Then

            MsgBox "No posee dato en celda A1", vbCritical, "¡ ¡ ¡ ERROR ! ! !"

            Exit Sub

        End If

        Set obj = CreateObject("WScript.Shell")

            car = obj.SpecialFolders("Desktop") & "\CARPETAS\" & Sheets("Cedula").Range("A1")

            pds = car & "\" & Sheets("Cedula").Range("A1") & ".jpg"

        Set obj = Nothing

        Set obj = CreateObject("Scripting.FileSystemObject")

            If obj.FolderExists(car) = False Then obj.CreateFolder (car)


        Set obj = Nothing


Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single

Application.DisplayAlerts = False

With Range("a2:d46")

Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture

End With

With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)

.Chart.Paste

.Chart.Export pds

.Delete

End With

Application.DisplayAlerts = True

End Sub


[/CODE]

Pero... la imagen me sale distorsionada y al imprimir me sale mucho mas grande de lo que realmente es... alguien me puede ayudar con ese pequeño problema?????

[color=blue]- - - - - Mensaje combinado - - - - -[/color]

Estimados Amigos,

He encontrado un programa que me exporta la hoja en .jpg exelente, se llama Universal Document Converter se maneja como una impresora, pero necesito una macro para crear la carpeta con el nombre de la celda A1 dentro de la carpeta llamada "CARPETAS" que se encuentra en el escritorio, llamar a este programa UDC "impresora" y luego guardar el archivo.jpg con el mismo nombre de la carpeta...

POR FAVOR AYÚDENME, me estoy rompiendo la cabeza y no encuentro la forma