Guardar libro de Excel con Nombre de Celda y abrir cuadro de dialogo guardar como.

Esta pregunta es recurrente pero siempre hay una necesidad especifica. Lo que necesito hacer es que el Usuario intervenga lo menos posible y darle solo las opciones de aceptar o cancelar.

La macro que necesito debe hacer lo siguiente:

  1. Abrir el cuadro de dialogo de "Save as" para que el usuario escoja donde va a guardar el archivo.
  2. Tomar el valor de la celda A2 y asignar ese valor como nombre del archivo.( Evitando que usuario asigne nombre, esto es para mantener un standar de nombres, ahi tengo formula concatenar)
  3. Revisar si ya existe un archivo con ese nombre y preguntar si quiere reemplazarlo o cancelar.
  4. El libro debe ser guardado como habilitado para macros.

1 Respuesta

Respuesta
2

Sub Guardar

REM Esta macro permite guardar un archivo excel en formato xlsm, usando el nombre de la celda B2.

On Error Goto PROBLEMA

Dim nombrearchivo as string

Chdir ("c:\")

Chdir ("c:\miregistro\")

Activesheet.Range("A1").select

nombrearchivo = Ucase( _

    Activesheet.Range("B1").value)

If Len(nombrearchivo) < 4 then

Msgbox "Verifique Celda B1, contenga un nombre valido."

Activesheet.Range("B1").select

Exit Sub

End if

Application.Dialogs (xldialogSaveAs).Show arg1:=nombrearchivo&".xlsm"

PROBLEMA:

Msgbox "Existe un error, reintente nuevamente, verifique que la carpeta MisRegistros, exista."

Exit Sub

End Sub

Estimado Experto.

Lamentablemente esta macro no se adapta a la necesidad que tengo. Se detiene en Ucase name.

Le agradezco mucho tratar de ayudarme, seguiré en la búsqueda de la solución.

Saludos.

. L .l Buenas estimado, copie y pegue de nuevo esta...

Sub Guardar

REM Esta macro permite guardar un archivo excel en formato xlsm, usando el nombre de la celda B2.

On Error Goto PROBLEMA

Dim nombrearchivo as string

Chdir ("c:\")

Chdir ("c:\miregistro\")

Activesheet.Range("A1").select

nombrearchivo = _

                     Range("B1").value

If Len(nombrearchivo) < 4 then

Msgbox "Verifique Celda B1, contenga un nombre valido."

Activesheet.Range("B1").select

Exit Sub

End if

Application.Dialogs (xldialogSaveAs).Show arg1:=nombrearchivo&".xlsm"

Exit Sub

REM Termina procedimento.

PROBLEMA:

Msgbox "Existe un error, reintente nuevamente, verifique que la carpeta MisRegistros, exista."

Exit Sub

End Sub

PRUEBE ESTE... puede ser que el Ucase no se valide en su version de excel, aunqur yo lo uso mucho en office 2003, 2007, y 2019 y nunca falla. Saludos .l .m

Adapte las celdas que necesito pero no corre.

He encontrado alguna macros que se adaptan pero con el inconveniente que no abre el cuadro de dialogo que es vital para lo que necesito. Si me quiere ayudar tratare de enviarle alguna que funcione para hacerle solo la modificacion de mostrar el Save as dialogue. Slds.

. L. l Tranquilidad, va de nuevo, va de nuevo (ahora que tengo una computadora a mano. Je je)

Sub Guardar()
Rem Esta macro permite guardar un archivo excel en formato xlsm, usando el nombre de la celda B2.
On Error GoTo PROBLEMA
Dim nombrearchivo As String
ChDir ("c:\")
ChDir ("c:\miregistro\")
ActiveSheet.Range("A1").Select
nombrearchivo = _
        Range("B1").Value
If Len(nombrearchivo) < 4 Then
MsgBox "Verifique Celda B1, contenga un nombre valido."
ActiveSheet.Range("B1").Select
Exit Sub
End If
Application.Dialogs(xlDialogSaveAs).Show _
arg1:=nombrearchivo & ".xlsm", arg2:=xlOpenXMLWorkbookMacroEnabled
Exit Sub
Rem Termina procedimento.
PROBLEMA:
MsgBox "Existe un error, reintente nuevamente, verifique que la carpeta MisRegistros, exista."
Exit Sub
End Sub

Con esto le estamos pasando el segundo argumento, para que forzadamente funcione, me encontré conque office 2019 no da error, mientras que en office 2007 si molesta.

Espero haya aclarado la duda. Saludos .l .l

Estimado Amigo. ! Bingo! Lo hicimos.

Tuve que eliminar tres líneas de instrucciones:

ChDir ("c:\")
ChDir ("c:\miregistro\")
ActiveSheet.Range("A1").Select

Porque daban problema, me obligaban a tener una carpeta "Miregistro" y me seleccionaba la celda A1 innecesariamente.

Luego adapte las celdas que necesitaba y corrió Satisfactoriamente.

Con eso cerramos la pregunta con resultado POSITIVO. Agradezco infinitamente su tiempo y dedicación para ayudarme. Bendiciones.

Por si alguien tiene una futura necesidad similar aquí dejo como quedo la macro después de adaptarla a lo que necesitaba. (Compartir es una virtud)

Sub Guardar()
Rem Esta macro permite guardar un archivo excel en formato xlsm, usando el nombre de la celda A2.
Application.ScreenUpdating = False
On Error GoTo PROBLEMA
Dim nombrearchivo As String
nombrearchivo = _
Range("A2").Value
If Len(nombrearchivo) < 4 Then
MsgBox "Verifique Celda A2, contenga un nombre valido."
ActiveSheet.Range("A2").Select
Exit Sub
End If
Application.Dialogs(xlDialogSaveAs).Show _
arg1:=nombrearchivo & ".xlsm", arg2:=xlOpenXMLWorkbookMacroEnabled
Exit Sub
Rem Termina procedimento.
PROBLEMA:
MsgBox "Existe un error, reintente nuevamente, verifique que la carpeta MisRegistros, exista."
Exit Sub
Application.CutCopyMode = True
End Sub

Me alegro que le sirviera.

El caso del CHDIR, era para ayudar a seleccionar la carpeta, donde usted necesitaba guardar el archivo. Pero igual solo era opcional.

Una observación, tenga cuidado al usar la instrucción:

Application.ScreenUpdating = False

Algunas veces puede congelarse excel, si se da algún error durante la ejecución de la macro. Saludos .l..l

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas