Saltar al contenido

una macro puede grabar “datos” en ella misma?


celta04

Recommended Posts

publicado

Hola:

Pregunte en otro sitio y me dijeron que era imposible, pero ayer buceando en el foro vi una pregunta antigua del estilo.

La pregunta era si “Es posible alterar el código VBA mediante el propio código VBA”, y era posible, y mi pregunta es: si una macro puede grabar “datos” en sí misma?.

La razón:

Tengo un archivo Excel “F:\Mi archivo excel.xlsm” con una macro que coge los datos de otro archivo que casi siempre está en la misma ruta, por lo que esa ruta es la que tiene la macro, “D:\Pruebas de Excel\Prueba_1_excel.xls”. Pero si mañana se cambia el directorio del archivo de datos a “D:\Cambio\Prueba_1_excel.xls”, o incluso el nombre “D:\Cambio\Prueba_2_excel.xls”, le tengo puesto Application.FileDialog(msoFileDialogOpen) para buscar la nueva ubicación yo, y luego modifico la macro con la nueva ruta/nombre.

Hay alguna forma de que la macro coja esa nueva ubicación y se lo guarde ella sola en lugar del antiguo? O eso es imposible y hay que hacerlo a mano y guardar de nuevo la macro como lo estoy haciendo hasta ahora?.

La referencia es absoluta al archivo por que casi siempre está en la misma carpeta, y si alguna vez cambia, es al cambiar el año (que se cambia el nombre por el del nuevo año) o por cambio de pc (cada tres años). Como veis no es un fallo habitual y fácilmente arreglable, es mas cosa de rizar el rizo, que para mis nulos conocimientos llegar hasta donde he llegado me parece demasiado. Al principio de año solo sabía de macros con la “grabadora de macros”, y ahora a base de buscar por la web me he atrevido, eso sí, solo con módulos normales, con módulos de clase y userform aun me pierdo…mas bien no me encuentro jajaja

No adjunto archivo porque entiendo que es mas falta de conocimientos míos y no he sabido googlear bien, pero si consideráis que es necesario lo subo.

Muchas gracias y un saludo.

publicado

Saludos.

No te entiendo muy bien pero si lo que quieres es saber la ruta del nuevo archivo se puede hacer media vez no cambie el nombre de la carpeta contenedora, una opción seria por ejemplo listar los libros de la carpeta en un rango de celdas o un formulario y asi saber cual es el que te interesa lo seleccionarias y tomarias la ruta del archivo y lo abririas te pongo dos macros una para listar y otra para abrir.

Sub ListarLibros()
Dim MiArchivo As String
Carpeta = "D:\Pruebas"
MiArchivo = Dir(Carpeta & "\*.xls*", 0)
i = 2
Do While MiArchivo <> ""
i = i + 1
Cells(i, 1) = Carpeta & "\" & MiArchivo
MiArchivo = Dir
Loop
End Sub[/PHP]

[PHP]Sub AbrirLibro()
Application.ScreenUpdating = False
Workbooks.Open Filename:=ActiveCell
ThisWorkbook.Activate
Application.ScreenUpdating = True
End Sub
[/PHP]

Atte.

joshua

publicado

Ante todo muchas gracias por responder:

Lamento mucho no haberme explicado bien.

Atraves de un miniexplorador de Windows encuentro el archivo nuevo donde esta, y le asigno una variable para que lo abra y coja los datos, incluso le he puesto un texbox que me indica su ruta, luego voy a la macro y cambio la ruta fija por la nueva para que la próxima vez haga todo el proceso él solo en menos de un segundo.

La pregunta es si hay alguna forma, algún código, que coja esa variable, que incluso sale en el texbox, y la ponga en lugar de la variable anterior…vamos, lo que hago yo posteriormente que lo haga él solito.

Mejor adjunto los dos archivos, el mío y el de donde coge los datos, ya sé que es un caos de código y poco optimizado, pero ya he dicho que no tengo ni idea de macros, VBA, programacion...voy viendo cosas por la web que me interesan y las adapto a mis necesidades, muchos códigos no tengo ni idea que hacen….peeeero….funciona.

Muchas gracias por todo

Pruebas Excel.rar

publicado

El nombre del archivo se coge de la celda D1.

El icono "folder" te permite cambiar el nombre del archivo. Por seguridad, debes desproteger la hoja previamente para realizar esta acción.

He reorganizado un poco la macro, prueba y comentas.

01 Mi Archivo año 2012.xls

publicado

No sé cómo poner para demostrar mi sorpresa, admiración…me parece impresionante y muy elegante la forma que has dispuesto, de verdad que no sé cómo darte las gracias.

El único inconveniente era a la hora de pegar los datos copiados, daba error al hacer el pegado especial necesario para cambiar los datos de horizontal a vertical. Después de muchas pruebas descubrí que era por cerrarse el archivo de origen antes de hacer el pegado. Lo he solucionado cerrando el archivo de origen después de haber pegado los datos.

He visto varios aportes tuyos y no dejan nunca de sorprenderme, tu imaginación no tiene limite!!! De verdad que muchísimas gracias por todo y un saludo.

Se pude dar por solucionado.

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.