UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se pueden hacer consultas de Excel o VBA por mensaje privado.
Utiliza el botón buscar del foro y te ahorras tiempo para obtener "ayuda".

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

Jhonsi70


Buenos días,

Agradecería mucho si me pueden ayudar a modificar macro que guarda albaran en PDF.

Como veréis en archivo adjunto, tendo un libro con dos hojas. La primera genera un albarán y los datos se pasan en forma de listado a la hoja 2 "VENTAS". Además al pulsar el botón guarda simultaneamente el albarán en PDF y lo guarda en una carpeta que se llama AlbaranesPDF.

Necesito que la macro al pasar los datos de Albaran a Ventas, en la columna C, que pertenece al número de albarán, cree un hipervinculo con el archivo PDF al que corresponde.

No se si es posible, pero me ajilizaría mucho la faena, ya que hablamos de unos 1000 albaranes al mes.

Gracias y un saludo

Jhonsi70


No me es posible adjuntar archivo, por lo que os incluyo aquí la macro que crea el PDF y pasa los adatos de "albarán" a "VENTAS".

Sub agrupar_albaranes()
Application.ScreenUpdating = False
'PASAR DATOS ALBARAN A HOJA VENTAS
Dim nALB, ruta, LIBRO, ArchivoPdf As String
       
        Set nALB = Range("E14")
        ruta = ThisWorkbook.Path & "\AlbaranesPDF\"
        LIBRO = nALB
        ArchivoPdf = ruta & LIBRO
       
       
            With ActiveSheet
                .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ArchivoPdf, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
               
            End With
         
       
       
origen = ActiveSheet.Name
destino = "VENTAS"
cliente = [e1].Value
clase = [f1].Value
numalb = [e14].Value
fecha = [e15].Value
If cliente = "" Or numalb = "" Then
MsgBox "Revise, por favor, que el Código de cliente y el número de albarán están incluidos.", vbInformation, "Faltan datos"
Exit Sub
End If
UserForm1.Show

With Range("a18:a57")
Set c = .Find("")
tam = c.Row
End With
With Sheets(destino).Columns("a:a")
Set vac = .Find("")
vacia = vac.Row
End With
Sheets(destino).Range("a" & vacia & ":" & "a" & vacia + (tam - 17)) = cliente
Sheets(destino).Range("b" & vacia & ":" & "b" & vacia + (tam - 17)) = clase
Sheets(destino).Range("c" & vacia) = numalb
Sheets(destino).Range("d" & vacia) = fecha
Sheets(destino).Range("f" & vacia) = "Importe bruto " & Sheets(origen).Range("I59").Value & " Euros"
Sheets(origen).Range("  a18: d" & tam - 1).Copy
Sheets(destino).Range("e" & vacia + 1).PasteSpecial xlValues
Sheets(origen).Range("  g18: i" & tam - 1).Copy
Sheets(destino).Range("i" & vacia + 1).PasteSpecial xlValues
Sheets(origen).Range("  z18: ae" & tam - 1).Copy
Sheets(destino).Range("l" & vacia + 1).PasteSpecial xlValues
Application.CutCopyMode = False
Sheets(destino).Activate
Range("a" & vacia).Select
Sheets(origen).Activate

[e1].ClearContents
[e14] = [e14] + 1
Range("a18:a57").ClearContents
Range("e18:g57").ClearContents

[e1].Select
Application.ScreenUpdating = True

End Sub

tyno


Hola jhonsi.
El tema de abrir un pdf es un poco complicadillo para hacerlo por este medio porque hay que ver la ruta de los archivos, que versión de Excel tienes y quizas algún otro detalle. No estoy muy practico en esta clase de macro pero al tratarse de vincular programas y rutas la cosa siempre es compleja. Lo que te resultaría más facil es hacer una macro que te abra la carpeta que contiene los pdf.
Por ejemplo esta macro si te animas a modificar las referencias sirve para abrir una carpeta desde Excel:

ruta = "C:\Documents and Settings\Usuario\Escritorio\CARPETA PDF"
ShellExecute 0, "Open", ruta, "", "", 1

Si bien esta macro esta confeccionada para abrir una suspuesta carpeta llamada "CARPETA PDF" en el Escritorio de Win XP, es facil establecer la ruta de la carpeta que deseemos en cualquier Windows con solo ver las propiedades de la carpeta de destino. Saludos
Saludos

Jhonsi70


Agradezco mucho la respuesta, pero he encontrado la solución.
La publico para aquellos que les pueda interesar.
En color rojo estan los datos que he añadido.
MIL GRACIAS Y UN SALUDO.
 
Dim nALB, ruta, LIBRO, ArchivoPdf As String
        
        Set nALB = Range("E14")
        ruta = ThisWorkbook.Path & "\AlbaranesPDF\"
        LIBRO = nALB
        ArchivoPdf = ruta & LIBRO
        
        
            With ActiveSheet
                .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ArchivoPdf, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
                
            End With
          
        
        
origen = ActiveSheet.Name
destino = "VENTAS"
cliente = [e1].Value
clase = [f1].Value
numalb = [e14].Value
fecha = [e15].Value
If cliente = "" Or numalb = "" Then
MsgBox "Revise, por favor, que el Código de cliente y el número de albarán están incluidos.", vbInformation, "Faltan datos"
Exit Sub
End If
UserForm1.Show
With Range("a18:a57")
Set c = .Find("")
tam = c.Row
End With
With Sheets(destino).Columns("a:a")
Set vac = .Find("")
vacia = vac.Row
End With
Sheets(destino).Range("a" & vacia & ":" & "a" & vacia + (tam - 17)) = cliente
Sheets(destino).Range("b" & vacia & ":" & "b" & vacia + (tam - 17)) = clase
Sheets(destino).Range("c" & vacia) = numalb
Sheets(destino).Hyperlinks.Add Anchor:=Sheets(destino).Range("c" & vacia), Address:= _
        ThisWorkbook.Path & "\AlbaranesPDF\" & numalb & ".pdf"
        
Sheets(destino).Range("d" & vacia) = fecha
Sheets(destino).Range("f" & vacia) = "Importe bruto " & Sheets(origen).Range("I59").Value & " Euros"
Sheets(origen).Range("  a18: d" & tam - 1).Copy
Sheets(destino).Range("e" & vacia + 1).PasteSpecial xlValues
Sheets(origen).Range("  g18: i" & tam - 1).Copy
Sheets(destino).Range("i" & vacia + 1).PasteSpecial xlValues
Sheets(origen).Range("  z18: ae" & tam - 1).Copy
Sheets(destino).Range("l" & vacia + 1).PasteSpecial xlValues
Application.CutCopyMode = False
Sheets(destino).Activate
Range("a" & vacia).Select
Sheets(origen).Activate
Application.ScreenUpdating = False
End sub

Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.