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

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