SALVAR DOCUMENTO VARIAS VECES

[lyilaly]

BUEN DIA,

TENGO UNA RUTINA EN VBA QUE ME PERMITE AÑADIR A TRAVES DE UNA FORMA VARIOS CAMPOS A UNA HOJA DE EXCEL, EN OTRA HOJA TENGO UN "FORMATO DE IMPRESION" EL CUAL RECIBE LOS MISMOS DATOS DE LA FORMA PERO EN OTROS CAMPOS, LUEGO DICHO "FORMATO DE IMPRESION" SE COPIA A UN LIBRO EN BLANCO Y SE LE ASIGNA EL NOMBRE DE LA "CELDA (B10)".XLS, LUEGO SE IMPRIME, SALVA Y CIERRA.

LO QUE NECESITO ES SABER SI ES POSIBLE SALVAR VARIAS HOJAS PARA EL MISMO VALOR DE LA CELDA (B10), Y NO QUE SOBREESCRIBA LA ANTERIOR.

SALUDOS,

LEO.

 

[Greg Truby]

¿Dentro del mismo directorio? No. Pero sí, si utiliza directorios distinctos. Fuera de eso, necesitaría implementar una esquema de celda B10 + sufijo.xls para generar nombres. Sufijo puede ser un contador que incrementa cada vez o la hora (sin los dos puntos) o cualquier otra cosa que le parece lógica.

O, y NO ES NECESARIO GRITAR (ESCRIBIR EN TODO MAYÚSCULA). Le oimos perfectamente bien si se usa voz normal. :wink:

 

[lyilaly]

Gracias por tu respuesta Greg y mil disculpas por lo de las mayúsculas, es que luego de haber escrito fu que me di cuenta y no quise escribir todo de nuevo.

Si, necesito que se guarden en el mismo directorio.

Podrias por favor ayudarme con lo del contador???, cual seria la logica a aplicar??? solo un n=1 y luego n=n+1??, esto se aplicaría sólo para los archivos con el mismo nombre (B10)??? o para todos los archivos que se guarden???

Saludos,

Leo

 

[Greg Truby]

Leo,

Sería algo parecido a este:

Sub ProbarSalvar()
    SalvarConContador
End Sub

Sub SalvarConContador(Optional wb As Workbook)
    '// se va a guardar el archivo con un nombre
    '// MI ARCHIVO xxx.XLS
    '// Se supone que si os tres caracteres antes del punto
    '// no corresponden a un número entonces el archivo no
    '// ha sido guardado con un contador todavía.
    
    Dim intContador As Integer, strContador As String, p%, strNombre As String
    
    If wb Is Nothing Then Set wb = ActiveWorkbook
    
    strNombre = wb.Name
    p = InStr(1, strNombre, ".")
    
    If p = 0 Then
        '// el archivo nunca ha sido guardado
        strNombre = InputBox("Nombre para el archivo?", "Nombre", strNombre)
        p = Len(strNombre)
        strContador = "0"
    ElseIf p < 3 Then
        strContador = "0"
    Else
        strContador = Mid(strNombre, p - 3, 3)
    End If
    
    intContador = Val(strContador)
    
    If intContador = 0 Then
        strNombre = Mid(strNombre, 1, p)
    Else
        strNombre = Mid(strNombre, 1, p - 5)
    End If
    
    intContador = intContador + 1
    
    strNombre = strNombre & Format(intContador, " 000") & ".xls"
    
    wb.SaveAs strNombre
    
End Sub

 

[Greg Truby]

Uy, actualmente se me olvidó un componente. Sería buena idea revisar el directorio para ver si existe el archivo con el nuevo contador antes de salvar y seguir incrementando hasta que tenga un número/nombre de archivo que no existe. Pero al momento no tengo tiempo para hacerle esto. Haga un intento usted y si tiene problema, háganos saber.

Saludos,

 

[lyilaly]

Buen Dia,

Gracias por tu respuesta Greg, aqui está el codigo de como adapte tu codigo, pero no consigo que pase de nombre de archivo 001.xls....

De 000 a 001 lo hace bien, pero de 001 a 002 me dice que 001 ya existe que si deseo sobreescribir, no se si fue por obviar parte de tu codigo o si tengo un error en la forma de plantear la situacion.

Public Sub TestFileExistence(Optional wb As Workbook)
Dim intContador As Integer, strContador As String, strNombre As String
   
    If wb Is Nothing Then Set wb = ActiveWorkbook
        intContador = 0
        strNombre = Worksheets("Formato de Impresión").Range("B10").Value
        strNombre = strNombre & Format(intContador, " 000") & ".xls"
    
    If FileFolderExists("D:\Documents\My documents\Programación\EPP Sheets\" & strNombre) Then
        intContador = intContador + 1
        strNombre = Worksheets("Formato de Impresión").Range("B10").Value
        strNombre = strNombre & Format(intContador, " 000") & ".xls"
        wb.SaveAs Filename:="D:\Documents\My documents\Programación\EPP Sheets\" & strNombre: Exit Sub
    Else
        wb.SaveAs Filename:="D:\Documents\My documents\Programación\EPP Sheets\" & strNombre: Exit Sub
    End If
End Sub

Gracias de nuevo por tu ayuda,

Leo

 

[lyilaly]

Disculpa Greg,

Ya lo resolvi, gracias por tu atencion. Anexo el código.

Public Sub TestFileExistence(Optional wb As Workbook)
Dim intContador As Integer, strContador As String, strNombre As String
   
    If wb Is Nothing Then Set wb = ActiveWorkbook
        strNombre = Worksheets("Formato de Impresión").Range("B10").Value
        strNombre = strNombre & Format(intContador, " 000") & ".xls"
    
    If FileFolderExists("D:\Documents\My documents\Programación\EPP Sheets\" & strNombre) Then
        Do While FileFolderExists("D:\Documents\My documents\Programación\EPP Sheets\" & strNombre) <> False
        intContador = intContador + 1
        strNombre = Worksheets("Formato de Impresión").Range("B10").Value
        strNombre = strNombre & Format(intContador, " 000") & ".xls"
        Loop
        wb.SaveAs Filename:="D:\Documents\My documents\Programación\EPP Sheets\" & strNombre: Exit Sub
    Else
        wb.SaveAs Filename:="D:\Documents\My documents\Programación\EPP Sheets\" & strNombre: Exit Sub
    End If
End Sub

Saludos,

Leo

 

[lyilaly]

Disculpa Greg,

Ya lo resolvi, gracias por tu atencion. Anexo el código.

Public Sub TestFileExistence(Optional wb As Workbook)
Dim intContador As Integer, strContador As String, strNombre As String
   
    If wb Is Nothing Then Set wb = ActiveWorkbook
        strNombre = Worksheets("Formato de Impresión").Range("B10").Value
        strNombre = strNombre & Format(intContador, " 000") & ".xls"
    
    If FileFolderExists("D:\Documents\My documents\Programación\EPP Sheets\" & strNombre) Then
        Do While FileFolderExists("D:\Documents\My documents\Programación\EPP Sheets\" & strNombre) <> False
        intContador = intContador + 1
        strNombre = Worksheets("Formato de Impresión").Range("B10").Value
        strNombre = strNombre & Format(intContador, " 000") & ".xls"
        Loop
        wb.SaveAs Filename:="D:\Documents\My documents\Programación\EPP Sheets\" & strNombre: Exit Sub
    Else
        wb.SaveAs Filename:="D:\Documents\My documents\Programación\EPP Sheets\" & strNombre: Exit Sub
    End If
End Sub

Saludos,

Leo