Renombrar archivo de Excel con vba sin necesidad de cerrar y abrir

En cuántas ocasiones te ha pasado que el archivo con el que estás trabajando necesitas cambiarle el nombre ??

El procedimiento que seguramente realizarías es: cerrar el archivo, ir al explorador de windows, ubicar el archivo y darle en cambiar nombre; posteriormente abriríamos el archivo.

En un inicio, la siguiente macro detecta el tipo de archivo (.xls, .xlsx, .xlsm) para que sea el mismo que el archivo nuevo. Posteriormente nos muestra el cuadro diálogo Guardar como… para que ingresemos el nuevo nombre.

Código de la macro 

':: Fecha de creación, 19-abr-11
':: Propósito, renombrar archivo actual
'... macro incluída en EXCELeINFO add-in, apartado Archivos
Sub EXCELeINFORenombrarArchivoActual()
Dim Ext As String
Dim NombreArchivo
Dim NombreActual As String
Dim RutaArchivo As String
Dim NombreCompleto As String
Dim Msj As String
On Error GoTo Errores
NombreActual = ActiveWorkbook.Name
RutaArchivo = ActiveWorkbook.Path
NombreCompleto = RutaArchivo & "" & NombreActual
'Detecta la extensión del libro actual.
Select Case ActiveWorkbook.FileFormat
    Case Is = 51
        Ext = "Libro de Excel (*.xlsx), *.xlsx"
     Case Is = 52
        Ext = "Libro de Excel habilitado para macros (*.xlsm), *.xlsm"
      Case Is = 56
        Ext = "Libro de de Excel 97 - 2003 (*.xls), *.xls"
End Select
'Se manda llamar el cuandro de diálogo Guardar como.
ChDir RutaArchivo
NombreArchivo = Application.GetSaveAsFilename(, FileFilter:=Ext, _
    Title:="EXCELeINFO: renombrar archivo actual")
Application.DisplayAlerts = False
'Si el nombre está en blanco o se presiona Cancelar, no se hace nada.
If NombreArchivo <> False Then
    'No realizar nada cuando los nombres sean iguales.
    If NombreArchivo = NombreCompleto Then
        MsgBox "No se realizó ningún cambio." & vbNewLine & vbNewLine & _
        "El nombre actual y el nombre nuevo son exactamente iguales.", vbInformation, "EXCELeINFO"
    Exit Sub
    Else
    'Si los nombre son diferentes, elimina el anterior y guarda el nuevo.
    ActiveWorkbook.SaveAs (NombreArchivo)
    Kill NombreCompleto
    Msj = "Se realizó el cambio de nombre satisfactoriamente:" & vbNewLine & vbNewLine
    Msj = Msj & "Nombre anterior: " & NombreCompleto & vbNewLine
    Msj = Msj & "Nombre nuevo: " & NombreArchivo
    MsgBox Msj, vbInformation, "EXCELeINFO"
    End If
End If
Exit Sub
Errores:
MsgBox "Ha ocurrido un error: " & vbNewLine & vbNewLine & err.Description, vbExclamation, "EXCELeINFO"
End Sub