GUARDARHOJA enviar y guardar hoja con etiqueta de hoja

Para DAN me ayudaste con que se envíe y guarde esta genial...

Mira en esa hoja hay referencias de otras hojas del mismo libro que al guardar y abrir la hoja que se guardo este me sale con que hay vínculos y etc etc

Como puedo volver valores los datos que contiene la hoja a guardar y este al guardar me lo guarde con el nombre de una celda de la misma hoja...

1 Respuesta

Respuesta
1

H o l a:

Te anexo la macro para guardar las fórmulas con valores y toma el valor de la celda A1 para nombrar el archivo, cambia A1 en la siguiente línea de la macro por la celda que desees:

arch = ruta & "\" & h1.[A1] & ".xlsm"

Sub GuardarHoja()
'Por.Dante Amor
    Sheets("Hoja1").Copy
    Set l2 = ActiveWorkbook
    Set h1 = l2.ActiveSheet
    For Each v In h1.UsedRange.SpecialCells(xlCellTypeFormulas, 23)
        v.Value = v.Value
    Next
    ruta = escritorio
    If ruta <> "" Then
        arch = ruta & "\" & h1.[A1] & ".xlsm"
        l2.SaveAs Filename:=arch, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        l2.Close
        Set dam = CreateObject("outlook.application").createitem(0)
        dam.To = "[email protected]"
        dam.Subject = "Asunto"
        dam.body = "Cuerpo del mensaje"
        dam.Attachments.Add arch
        dam.Send                    'El correo se envía en automático
    Else
        MsgBox "No se ecuentra la carpeta Escritorio", vbCritical
    End If
End Sub

S a l u d o s

ejeucte el código y se me atoro la compu... solo aparece las fórmulas convirtiéndose en valores... y así se queda

hola dan

mira

Sub GuardarHoja()
'Por.Dante Amor
Sheets("Hoja1").Copy
Set l2 = ActiveWorkbook
ruta = escritorio
If ruta <> "" Then
arch = ruta & "\hoja.xlsm"
l2.SaveAs Filename:=arch, FileFormat:=xlOpenXMLWorkbookMacroEnabled
l2.Close
End Sub

olvidemos enviar el correo...

solo necesito que:

1. SE GUARDE  EN EL ESCRITORIO CONSERVANDO MACROS DE LA HOJA

2. EL NOMBRE DEL LIBRO SEA EL DE UNA CELDA

3. LAS FORMULAS SE CONVIERTAN EN VALORES

4. SOLO SE GUARDE Y YA NO SE ENVIE

5. que solo sea un rango en especifico...

Sub GuardarHoja2()
'Por.Dante Amor
Sheets(Hoja12.Name).Copy
Set l2 = ActiveWorkbook
Set h1 = l2.ActiveSheet
For Each v In h1.UsedRange.SpecialCells(xlCellTypeFormulas, 23)
v.Value = v.Value
Next
ruta = escritorio
If ruta <> "" Then
arch = ruta & "\" & h1.[BADSF] & ".xlsm"
l2.SaveAs Filename:=arch, FileFormat:=xlOpenXMLWorkbookMacroEnabled
l2.Close
'El correo se envía en automático
Else
MsgBox "No se ecuentra la carpeta Escritorio", vbCritical
End If
End Sub

ALGO ASI nose ayudame porfa

Prueba con esta, como no me dices qué rango quieres le puse desde A1 hasta J11

Sub GuardarHoja()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets(Hoja12.Name)
    h1.Copy
    Set l2 = ActiveWorkbook
    Set h2 = l2.ActiveSheet
    Application.EnableEvents = False
    h2.Cells.ClearContents
    h1.Range("A1:J11").Copy
    h2.Range("A1").PasteSpecial Paste:=xlValues
    '
    ruta = escritorio
    If ruta <> "" Then
        arch = ruta & "\" & h1.[BADSF] & ".xlsm"
        l2.SaveAs Filename:=arch, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        l2.Close
    Else
        MsgBox "No se ecuentra la carpeta Escritorio", vbCritical
    End If
End Sub
Function escritorio() As String
'Por.DAM
'Referencia: http://www.ozgrid.com/forum/showthread.php?t=24985
    Dim objWSHShell As Object
    Dim strSpecialFolderPath
    On Error GoTo ErrorHandler
    Set objWSHShell = CreateObject("WScript.Shell")
        escritorio = objWSHShell.SpecialFolders("Desktop")
    Set objWSHShell = Nothing
    Exit Function
ErrorHandler:
    'MsgBox "Error NO se encuentra el folder ", vbCritical + vbOKOnly, "Error"
    escritorio = ""
End Function

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas