Guardar datos de un remito en diferentes hojas de excel
Te molesto de nuevo con este tema para ver si se puede hacer una pequeña modificacion al archivo queme mandaste. Lo que necesitaria es que en vez de Remito Nº xxxxx, aparezca nombreempresa + fecha como nombre de hoja. ¿Puede ser?.
1 respuesta
Respuesta de Dante Amor
1
H o l a:
Te anexo el código para crear la hoja con el nuevo nombre.
Sub Opcion1()
'crear una hoja en el mismo libro
'Por.Dante Amor
res = CrearHoja
If res <> 0 Then MsgBox "Hoja copiada con el nombre: " & res, vbInformation, "REMITO"
End Sub
'
Sub Opcion2()
'crear la hoja en un PDF
'Por.Dante Amor
res = CrearPdf
MsgBox "Hoja enviada a PDF con el nombre: " & res, vbInformation, "REMITO"
End Sub
'
Sub Opcion3()
'crear la hoja en el mismo libro y también la hoja en un pdf
'Por.Dante Amor
res = CrearHoja
If res <> 0 Then
CrearPdf
MsgBox "Hoja copiada y enviada a PDF con el nombre: " & res, vbInformation, "REMITO"
End If
End Sub
'
Function CrearHoja()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
nombre = h1.[E14]
If nombre = "" Then
MsgBox "El nombre de la empresa está vacío, corrija el nombre", vbCritical, "ERROR"
CrearHoja = 0
Exit Function
End If
nombre = Left(nombre, 17) & " " & Format(Date, "dd-mmm-yyyy")
'
For Each h In Sheets
If UCase(h.Name) = UCase(nombre) Then
existe = True
Exit For
End If
Next
If existe Then
MsgBox "Ya existe el nombre de hoja", vbCritical, "ERROR"
CrearHoja = 0
Exit Function
End If
Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
h2.Name = nombre
h1.Cells.Copy h2.[A1]
h1.Select
CrearHoja = nombre
Application.ScreenUpdating = True
End Function
'
Function CrearPdf()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
ruta = "C:\trabajo\varios\"
nombre = "remito " & h1.[G3]
h1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ruta & nombre & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
CrearPdf = nombre
End Function:)
S aludos. D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
;)
