Guardar copia de libro autonumerada

Hola Santiago
Esta es mi primera participación en el sitio, postee esta pregunta en el tablón hace unos días y no tuve respuesta por eso recurrí a un experto directamente. La consulta es la siguiente.
Tengo una plantilla excel con macro de guardado. Esta macro me guarda el libro activo en una ubicación especifica, con un nombre dado más la fecha. Ahora ... ¿Cómo puedo hacer que dentro de esa misma carpeta me cree otras por fecha y en caso de guardar más de un libro el mismo día, en vez de sobreescribir me agregue un numerador en el titulo?
Ej. Si en la carpeta 9-11-2009 existe el libro "Ejemplo del 9-11-2009" guardar como "Ejemplo 2 del 9-11-2009".
Muchas Gracias.
1

1 Respuesta

165.800 pts. Más de 35 años en la informática y más de 20 trabajando...
No se me había ocurrido hacer algo así, pero ahí va.
Este código tienes que ponerlo en el código VB del workbook:
Option Explicit
Dim snCambiandoNombre As Boolean
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim nomFich As String
    Dim miNombre As String
    Dim n As Integer
    If snCambiandoNombre Then Exit Sub
    miNombre = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    ' Si no existe el fichero dejamos que siga el proceso sin hacer nada
    If Not existeFichero(ThisWorkbook.Path & "\" & ThisWorkbook.Name) Then Exit Sub
    ' Si pasa por aquí es que ya existe. Primero quitamos la extensión XLS
    If UCase$(Right$(miNombre, 4)) = ".XLS" Then miNombre = Left$(miNombre, Len(miNombre) - 4) ' Quitamos el XLS
    ' Ahora miramos si ya es una versión (un número entre paréntesis), en ese caso lo quitamos
    ' Primero comprobamos si es una versión con un sólo dígito estilo (2)
    If Len(miNombre) > 3 Then
        If Mid$(miNombre, Len(miNombre) - 2, 1) = "(" And Mid$(miNombre, Len(miNombre), 1) = ")" And IsNumeric(Mid$(miNombre, Len(miNombre) - 1, 1)) Then
            ' Quitamos el número de versión del nombre
            miNombre = Left$(miNombre, Len(miNombre) - 3)
        End If
    End If
    ' Después comprobamos si es una versión con dos dígitos estilo (14)
    If Len(miNombre) > 4 Then
        If Mid$(miNombre, Len(miNombre) - 3, 1) = "(" And Mid$(miNombre, Len(miNombre), 1) = ")" And IsNumeric(Mid$(miNombre, Len(miNombre) - 1, 2)) Then
            ' Quitamos el número de versión del nombre
            miNombre = Left$(miNombre, Len(miNombre) - 4)
        End If
    End If
    ' Ya tenemos el nombre de este fichero sin extensión ni posible número de versión
    ' Ahora buscamos el número de versión nuevo (uno que no exista)
    n = 2
    Do
        nomFich = miNombre & "(" & Format$(n) & ").xls"
        If Not existeFichero(nomFich) Then Exit Do ' Este nos vale
        n = n + 1
    Loop
    ' Guardaremos el libro con el otro nombre y cancelaremos el proceso de guardado actual
snCambiandoNombre = True
    ThisWorkbook.SaveAs nomFich
    snCambiandoNombre = False
    ' Cancelamos el guardado del fichero actual
    Cancel = True
End Sub
Function existeFichero(ByVal nomFich As String) As Boolean
    Dim d As String
    On Error Resume Next
    d = Dir$(nomFich)
    If Err <> 0 Then d = nomFich
    On Error GoTo 0
    existeFichero = (d <> "")
End Function
Santiago:
Te agradezco por la prontitud de tu respuesta.
Probé el código y me funcionó perfecto.
Nuevamente te agradezco y te aseguro que pienso seguirte molestando.
Ya te agregue a la lista de favoritos ja ja..

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas