
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
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


0