Visual Basic para Aplicaciones - crear copia pdf desde excel

Life is soft - evento anual de software empresarial
 
Vista:
sin imagen de perfil

crear copia pdf desde excel

Publicado por DANIEL (1 intervención) el 16/01/2013 15:43:58
necesito llevar una archivo excel a pdf este el codigo completo. si alguien puede ayudarme muchas gracias.

segun yo el codigo a modificar es el subrayado.



Public Sub AsignarNumeroOC()
Dim i As Long
Dim n As Long
Dim NUMEROOC As Long

FinalRow = Sheets("Indice").Cells(Rows.Count, 1).End(xlUp).Row

NUMEROOC = 0
If FinalRow = 1 Then
Else
For i = 2 To FinalRow
If Sheets("Indice").Range("a" & i).Value > NUMEROOC Then
NUMEROOC = Sheets("Indice").Range("a" & i).Value
End If
Next
End If
Sheets("OC").Range("L1").Value = NUMEROOC + 1

End Sub


Public Sub GrabarOC()
Dim i As Long
Dim FinalRow As Long
Dim NUMEROOC As Long
Dim Fila As Long
Dim bExiste As Boolean
Dim FechaEmision As Date
Dim Proveedor As String
Dim Obra As String
Dim TotalOC As Long
Dim LibroNuevo As String
Dim LibroDestino As String
Dim sNumeroOC As String
Dim AreaOperativa As String
Dim Creador As String
Dim Neto As Long
Dim Rut As String
Dim Mes As String


NUMEROOC = Sheets("OC").Range("L1").Value
If NUMEROOC = 0 Then
MsgBox "No es posible grabar una OC sin numero."
Exit Sub
End If
LibroDestino = Sheets("OC").Range("L2").Value & "\" & Sheets("OC").Range("L3").Value
sNumeroOC = Sheets("OC").Range("D7").Value

FechaEmision = Sheets("OC").Range("I7").Value
Proveedor = Sheets("OC").Range("D9").Value
Obra = Sheets("OC").Range("G4").Value
TotalOC = Sheets("OC").Range("I59").Value
AreaOperativa = Sheets("OC").Range("G3").Value
Creador = Sheets("OC").Range("G2").Value
Neto = Sheets("OC").Range("I57").Value
Rut = Sheets("OC").Range("D12").Value
Mes = Sheets("OC").Range("I8").Value

FinalRow = Sheets("Indice").Cells(Rows.Count, 1).End(xlUp).Row
bExiste = False
For i = 2 To FinalRow
If Sheets("Indice").Range("a" & i).Value = NUMEROOC Then
Fila = i
bExiste = True
Exit For
End If

Next

If bExiste = False Then
Fila = FinalRow + 1
End If

Sheets("Indice").Range("a" & Fila).Value = NUMEROOC
Sheets("Indice").Range("b" & Fila).Value = FechaEmision
Sheets("Indice").Range("d" & Fila).Value = Proveedor
Sheets("Indice").Range("e" & Fila).Value = Obra
Sheets("Indice").Range("f" & Fila).Value = Neto
Sheets("Indice").Range("g" & Fila).Value = TotalOC
Sheets("Indice").Range("h" & Fila).Value = AreaOperativa
Sheets("Indice").Range("i" & Fila).Value = Creador
Sheets("Indice").Range("c" & Fila).Value = Rut
Sheets("Indice").Range("j" & Fila).Value = Mes

Workbooks.Add
ActiveWorkbook.Sheets(1).Name = "OC " & Format(NUMEROOC, "000")
ThisWorkbook.Sheets("OC").Range("A1:I72").Copy

Workbooks.Add
LibroNuevo = ActiveWorkbook.Name
Windows(LibroNuevo).Activate
Sheets(1).Name = "OC " & Format(NUMEROOC, "000")

Windows("OC formulario.xls").Activate
Sheets("OC").Select
Range("A1:I72").Select
Selection.Copy

Windows(LibroNuevo).Activate
ActiveSheet.Paste
Range("D7").Value = sNumeroOC
Sheets(1).Protect
Application.CutCopyMode = True
' ChDir "C:\Carpeta Temporal"
ActiveWorkbook.SaveAs Filename:=LibroDestino & ".xls", FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
True, CreateBackup:=False
ActiveWorkbook.Close

Sheets("OC").Range("L1").Value = ""
Sheets("OC").Range("L1").Select
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder