Saltar al contenido

Macro que grabe archivo de la forma nombre_fecha_hora y ..


Recommended Posts

publicado
Hace 5 horas, aaquino dijo:

@zero-x te funcionó el archivo?

si....pero aun no sé lo que me falta ( debe ser muy facil pero no lo veo) , si me explica que me falto estaria muy agradecido (ojala con una imagen pues me complico  con los nombres en ingles que me describes

 

gracias de antemano

 

publicado
Hace 17 horas, zero-x dijo:

si....pero aun no sé lo que me falta ( debe ser muy facil pero no lo veo)

Dime, qué es lo que te falta?, descargaste el último archivo que te dejé y lo probaste?

publicado
Hace 10 horas, aaquino dijo:

Dime, qué es lo que te falta?, descargaste el último archivo que te dejé y lo probaste?

Uff una cadena de mal entendidos

1) el ultimo archivo que me mandaste funciona bien

2) el que te mande yo ante ,(que yo lo veo igual)   a mi no me funciona

3) tu me dijiste que  no copie del todo , lo que habia que copiar para que funcionara mi archivo , pero

no veo que me falto  (algunas cosas que me dices en ingles no entiendo mucho a que se refieren)

4) en el ultimo post te pedi se indicabas con imagenes lo que le faltaba a mi archivo para que funcionara como el tuyo.

5)espero se entienda

 

 

publicado
Hace 12 horas, zero-x dijo:

4) en el ultimo post te pedi se indicabas con imagenes lo que le faltaba a mi archivo para que funcionara como el tuyo.

Ok, te explico

Como subir imágenes está algo complicado porque se volvería muy tedioso, así que mejor te lo explico de la mejor manera para que lo puedas entender:

a.) Entrar al VBA = Alt + F11

b.) Ahí vas a encontrar un panel de navegación al lado izquierdo, donde encontrarás el proyecto llamado VBAProject (Notas 30-06-16 ...)

c.) Dentro de ese proyecto encontrarás dos carpetas, una que se llama Microsoft Excel Objects u Objetos de Microsoft Excel (desde ahora la llamaré Objetos) y otra carpeta llamada Modules o Módulos (desde ahora la llamaré Módulos).

d.) Dentro de la carpeta Módulos vas a encontrar un ícono que representa a los módulos, que se llama Módulo1, le das doble clic a ese ícono

e.) Se abrirá una ventana al lado derecho, donde encontrarás el código vba que hice. Lo que debes hacer es seleccionar TODO el código, es decir las dos subrutinas que implementé, esto para copiar y pegar en un módulo del archivo que tú quieres utilizar.

f.) Dentro de la carpeta Objetos encontrarás dos íconos, uno que dice Hoja1 y otro que dice ThisWorkbook. Le das doble clic al segundo ícono

g.) Se abrirá otra ventana con código, que deberás seleccionar, para copiar y pegar en el archivo que quieres utilizar, dentro del mismo ícono de ThisWorkbook (Este ícono lo tienen todos los archivos de Excel, en la misma carpeta)

Ya con esto, guardas tu archivo y te debería de funcionar.

Creo que fui bastante claro, igualmente te invito a investigar un poco lo que es el VBA en Excel, hay bastantes tutoriales en YouTube que puedes buscar e informarte.

publicado

hola

Que raro te habia vuelto a preguntar, pero no esta la pregunta, mira se algo de excel pero esto de no encontrar algo no me habia pasado , no encuentro codigo  en donde me dices que si hay (en ThisWorkbook ) , que es lo que no copie , en lo veo , sorry por preguntar tanto pero en verdad no lo encuentro.

publicado

Te vuelvo a adjuntar el archivo ya finalizado, y mira, si quieres te lo puedo adaptar a tu proyecto....

Este es el código para que lo copies y pegues en un módulo:

Sub Guardado_Automatico()

Dim NombreActual As String
Dim NombreNuevo As String
Dim Ruta As String
Dim Archivo As String
Dim BackUpObligatorio As String
Dim Archivo2 As String
NombreActual = Hoja1.Range("A2")

Ruta = ThisWorkbook.Path
NombreNuevo = NombreActual & " " & Format(Date, "dd-mm-yy") & " " & Format(Now, "hh-mm-ss")
BackUpObligatorio = "BK " & NombreNuevo
Archivo = Ruta & "\" & NombreNuevo
Archivo2 = Ruta & "\" & BackUpObligatorio

ActiveWorkbook.SaveAs Filename:=Archivo & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.SaveAs Filename:=Archivo2 & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled


End Sub

Sub BackUp_Automatico()

Dim NombreActual As String
Dim NombreNuevo As String
Dim Ruta As String
Dim Archivo As String
NombreActual = Hoja1.Range("A2")

NombreNuevo = "BK " & NombreActual & " " & Format(Date, "dd-mm-yy") & " " & Format(Now, "hh-mm-ss")
Ruta = ThisWorkbook.Path
Archivo = Ruta & "\" & NombreNuevo

ActiveWorkbook.SaveAs Filename:=Archivo & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

End Sub

Sub Eliminacion_Automatica()

Dim Original As String
Dim BackUp As String
Dim Ruta As String
Dim EliminarOriginal As String
Dim EliminarBackUp As String

Original = Hoja1.Range("B2")
BackUp = "BK " & Original
Ruta = ThisWorkbook.Path
EliminarOriginal = Ruta & "\" & Original
EliminarBackUp = Ruta & "\" & BackUp

Kill EliminarOriginal
Kill EliminarBackUp

End Sub

Este es el código que debes copiar en el Thisworkbook (sólo le das doble clic al ícono que dice THISWORKBOOK, y lo pegas):

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False

Guardado_Automatico
Eliminacion_Automatica

Application.ScreenUpdating = True
End Sub

Private Sub Workbook_Open()

Dim Nombre As String
Nombre = ThisWorkbook.Name
Hoja1.Range("B2") = Nombre

End Sub

 

Macros.zip

publicado
En 11-07-2016 at 13:15 , aaquino dijo:

Te vuelvo a adjuntar el archivo ya finalizado, y mira, si quieres te lo puedo adaptar a tu proyecto....

Este es el código para que lo copies y pegues en un módulo:


Sub Guardado_Automatico()

Dim NombreActual As String
Dim NombreNuevo As String
Dim Ruta As String
Dim Archivo As String
Dim BackUpObligatorio As String
Dim Archivo2 As String
NombreActual = Hoja1.Range("A2")

Ruta = ThisWorkbook.Path
NombreNuevo = NombreActual & " " & Format(Date, "dd-mm-yy") & " " & Format(Now, "hh-mm-ss")
BackUpObligatorio = "BK " & NombreNuevo
Archivo = Ruta & "\" & NombreNuevo
Archivo2 = Ruta & "\" & BackUpObligatorio

ActiveWorkbook.SaveAs Filename:=Archivo & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.SaveAs Filename:=Archivo2 & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled


End Sub

Sub BackUp_Automatico()

Dim NombreActual As String
Dim NombreNuevo As String
Dim Ruta As String
Dim Archivo As String
NombreActual = Hoja1.Range("A2")

NombreNuevo = "BK " & NombreActual & " " & Format(Date, "dd-mm-yy") & " " & Format(Now, "hh-mm-ss")
Ruta = ThisWorkbook.Path
Archivo = Ruta & "\" & NombreNuevo

ActiveWorkbook.SaveAs Filename:=Archivo & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

End Sub

Sub Eliminacion_Automatica()

Dim Original As String
Dim BackUp As String
Dim Ruta As String
Dim EliminarOriginal As String
Dim EliminarBackUp As String

Original = Hoja1.Range("B2")
BackUp = "BK " & Original
Ruta = ThisWorkbook.Path
EliminarOriginal = Ruta & "\" & Original
EliminarBackUp = Ruta & "\" & BackUp

Kill EliminarOriginal
Kill EliminarBackUp

End Sub

Este es el código que debes copiar en el Thisworkbook (sólo le das doble clic al ícono que dice THISWORKBOOK, y lo pegas):


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False

Guardado_Automatico
Eliminacion_Automatica

Application.ScreenUpdating = True
End Sub

Private Sub Workbook_Open()

Dim Nombre As String
Nombre = ThisWorkbook.Name
Hoja1.Range("B2") = Nombre

End Sub

 

Macros.zip

Ahora si me aparecio el codigo que decias, en el ThisWorkbook , gracias por tu tiempo , pueden dar por cerrado el tema

  • Silvia bloqueó este tema

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29

    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • Hola, veo que tienes 365, así que esta forma funcionará   Almacen.xlsx
    • Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • Exelente solución mil gracias 
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.