¿Puedo ingresar una línea de una macro que haga que se me pregunte un dato extra en el nombre de archivo a guardar?
Esto es algo extraño, les comento. Tengo varios archivos que utilizan macros para guardar el archivo que modifico, aquí pasa algo... Los archivos tienen datos que varían, como productos, definiciones y otras cosas, es por eso que me gustaría que al apretar el botón de guardar el archivo se abra una ventana que me permita agregar una información antes, entre o después de las celdas que tomo para generar nombre, es algo extraño por lo que no se si me explique. Esta es la macro que utilizo para guardar;
Sub GUARDAR()
'
' GUARDAR Macro
'
Dim i As Long
Dim FinalRow As Long
Dim NUMEROCOT As Long
Dim Fila As Long
Dim bExiste As Boolean
Dim FechaEmision As Date
Dim Contacto As String
Dim LibroNuevo As String
Dim LibroDestino As String
Dim sNumeroOC As String
Dim NombreHoja As String
Dim Archivo As String
Dim Empresa As String
Dim Telefono As String
Dim Correo As String
'
Archivo = Sheets("GENERAL").Range("Q2").Value
NombreHoja = ActiveSheet.Name
NUMEROCOT = Sheets("GENERAL").Range("E3").Value
FechaEmision = Sheets("General").Range("E4").Value
Contacto = Sheets("General").Range("B3").Value
Empresa = Sheets("General").Range("B4").Value
Telefono = Sheets("General").Range("E5").Value
Correo = Sheets("General").Range("B5").Value
FinalRow = Sheets("Indice").Cells(Rows.Count, 1).End(xlUp).Row
bExiste = False
For i = 2 To FinalRow
If Sheets("Indice").Range("a" & i).Value = NUMEROCOT Then
Fila = i
bExiste = True
Exit For
End If
Next
If bExiste = False Then
Fila = FinalRow + 1
End If
Sheets("Indice").Range("a" & Fila).Value = NUMEROCOT
Sheets("Indice").Range("b" & Fila).Value = Contacto
Sheets("Indice").Range("c" & Fila).Value = Empresa
Sheets("Indice").Range("d" & Fila).Value = Telefono
Sheets("Indice").Range("e" & Fila).Value = Correo
Sheets("Indice").Range("f" & Fila).Value = FechaEmision
MsgBox "Se ha guardado '" & Archivo & "' en hoja INDICE"
Confirmacion = MsgBox("Desea guardar '" & Archivo & "', como archivo nuevo?", _
vbQuestion + vbYesNo, "IHL")
Application.ScreenUpdating = False
If Confirmacion = vbYes Then
'
'
ChDir "C:\Users\Silviom\Dropbox\IHL (1)\IHL Silvio\cotizaciones\excel"
Dim Ruta As String
Ruta = Application.GetSaveAsFilename([Q2]) & ("xls")
If Left(Ruta, 5) <> "Falso" Then
ActiveWorkbook.SaveCopyAs Filename:=Ruta
End If
'
Sheets("GENERAL"). Range("g17:i23"). ClearContents 'borrar celdas
Sheets("GENERAL"). Range("g28:i33"). ClearContents
Sheets("GENERAL"). Range("g38:i43"). ClearContents
Sheets("GENERAL"). Range("m30:o41"). ClearContents
Sheets("GENERAL"). Range("R30:T41"). ClearContents
Sheets("GENERAL"). Range("n28:n29"). ClearContents
Sheets("GENERAL"). Range("S28:S29"). ClearContents
Sheets("GENERAL").Range("b3") = ""
Sheets("GENERAL").Range("b32") = ""
Sheets("GENERAL").Range("b33") = ""
Sheets("GENERAL").Range("g13:g15") = ""
Sheets("GENERAL").Range("g26") = ""
Sheets("GENERAL").Range("g36") = ""
Sheets("GENERAL").Range("g46") = ""
'
ActiveWorkbook.Save
Else
End If
Workbooks.Open Ruta
End Sub
1 Respuesta
Luego de guardar datos en hoja Indice preguntas si desea guardar.
Entonces si la respuesta es SI a continuación podrás agregar lo que necesitas.
If Confirmacion = vbYes Then
'
'aquí agrega las nuevas condiciones, puede ser mediante un InputBox o tomando valores de otras celdas.
No comentas qué necesitas agregar por eso solo te indico en qué momento hacerlo. Aclara un poco más lo que deseas agregar si necesitas que te ayude con el código.
Justamente esta así en el código que adjunte, ahora bien, luego de realizar el proceso de guardado en Indice, comienza el proceso de guardado en la ruta, es en ese momento que me gustaría que salga una ventana desplegable de la que yo pueda agregar en escritura de teclado una observación como (cotización letrero o rotulación de vehículo), entonces lo que escribo se sume al nombre del archivo al guardar. Espero me haya explicado esta vez...
Entonces la sección de la confirmación quedaría así (*):
If Confirmacion = vbYes Then
ChDir "C:\Users\Silviom\Dropbox\IHL (1)\IHL Silvio\cotizaciones\excel"
Dim Ruta As String, otrotxt as string
Ruta = Application.GetSaveAsFilename([Q2]) & ("xls")
If Left(Ruta, 5) <> "Falso" Then
'solicito texto para agregar
otrotxt = InputBox("Ingrese lo que desea agregar al nombre del archivo")
'le quito la extensión y agrego la cadena antes
Ruta = Left(Ruta, Len(Ruta) - 4) & otrotxt & ".xls"
ActiveWorkbook.SaveCopyAs Filename:=Ruta
End If
End If(*) No se porqué utilizas la instrucción GetSave si ya le estás indicando ruta y nombre... eso se utiliza cuando necesitas 'buscar o establecer' la carpeta de destino.
Por lo tanto también podrías utilizar este código:
If Confirmacion = vbYes Then
Dim carpeta As String, Ruta As String, otrotxt As String
carpeta = "C:\Users\Silviom\Dropbox\IHL (1)\IHL Silvio\cotizaciones\excel\"
'solicito texto para agregar
otrotxt = InputBox("Ingrese lo que desea agregar al nombre del archivo")
Ruta = carpeta & ([Q2]) & "-" & otrotxt & ".xls"
ActiveWorkbook.SaveCopyAs Filename:=Ruta
End If
Observa que no necesito 'ubicarme' en la carpeta destino, que la variable 'carpeta' lleva la barra al final, que separo el nombre del archivo del texto agregado con un guión (puede ser cualquier otro caracter a gusto).
Te recuerdo que la consulta sigue pendiente de que comentes y/o valores la respuesta para darla por cerrada.
Sdos!
¡Gracias!
Utilizaba GetSave por que en ese momento le incluía la información adicional que desde ahora y gracias a ti podre hacerlo a través de la ventana que se abre.
Gracias Elsa!!
