Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Visual Basic » Codigo Macro de Excel almacenar registros

Visual Basic - Codigo Macro de Excel almacenar registros

Life is soft - evento anual de software empresarial
Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil

Codigo Macro de Excel almacenar registros

Publicado por Daniel (2 intervenciones) el 03/01/2024 21:40:53
Hola a toda la comunidad

Hice una tabla en Excel donde registro varios productos y por medio de un botón almaceno la lista de compra de estos, el código fuente es de una Macro que asocie a dicho botón dentro del mismo libro de Excel, el código funciona perfecto, solo que me almacena un registro a la vez y ahora deseo que almacene mas de uno. Ojala me puedan ayudar, muchas gracias.



Sub Registros()
'
' Registros Macro
' Macro para guardar histórico de Ordenes de Compras
'
' Acceso directo: CTRL+p
'

Dim strTitulo As String
Dim Continuar As String
Dim Registros As Range
Dim NuevaFila As Integer

Continuar = MsgBox("¿Deseas registrar la Orden de Compra?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub


Set Registros = ThisWorkbook.Worksheets("Registros").Cells(1, 1).CurrentRegion
'
NuevaFila = Registros.Rows.Count + 1
'
With ThisWorkbook.Worksheets("Registros")

.Cells(NuevaFila, 1).Value = ThisWorkbook.Sheets(1).Range("N8") 'Pedido
.Cells(NuevaFila, 2).Value = Date
.Cells(NuevaFila, 3).Value = ThisWorkbook.Sheets(1).Range("D2") 'Proyecto
.Cells(NuevaFila, 4).Value = ThisWorkbook.Sheets(1).Range("J2") 'Proveedor
.Cells(NuevaFila, 5).Value = ThisWorkbook.Sheets(1).Range("J3") 'R.F.C
.Cells(NuevaFila, 6).Value = ThisWorkbook.Sheets(1).Range("C12") 'Concepto
.Cells(NuevaFila, 7).Value = ThisWorkbook.Sheets(1).Range("G12") 'Unidad
.Cells(NuevaFila, 8).Value = ThisWorkbook.Sheets(1).Range("H12") 'Cantidad
.Cells(NuevaFila, 9).Value = ThisWorkbook.Sheets(1).Range("J12") 'Precio Unitario
.Cells(NuevaFila, 10).Value = ThisWorkbook.Sheets(1).Range("K12") 'Importe


.Cells(NuevaFila, 11).Value = ThisWorkbook.Sheets(1).Range("K32") 'Subtotal
.Cells(NuevaFila, 12).Value = ThisWorkbook.Sheets(1).Range("K33") 'IVA
.Cells(NuevaFila, 13).Value = ThisWorkbook.Sheets(1).Range("K36") 'Total
.Cells(NuevaFila, 14).Value = ThisWorkbook.Sheets(1).Range("D32") 'Observaciones

End With

MsgBox "El registro se almaceno de manera exitosa.", vbInformation, strTitulo

End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 1.259
Plata
Ha mantenido su posición en Visual Basic (en relación al último mes)
Gráfica de Visual Basic

Codigo Macro de Excel almacenar registros

Publicado por Antoni Masana (558 intervenciones) el 03/01/2024 22:38:34
Creo que lo que necesitas es esto:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub Registros()
    '
    ' Registros Macro
    ' Macro para guardar histórico de Ordenes de Compras
    '
    ' Acceso directo: CTRL+p
    '
 
    Dim strTitulo As String
    Dim Continuar As String
    Dim Registros As Range
    Dim Fila_Dest As Integer,  Fila_Orig As Integer
 
    Continuar = MsgBox("¿Deseas registrar la Orden de Compra?", vbYesNo + vbExclamation, strTitulo)
    If Continuar = vbNo Then Exit Sub
 
    Set Registros = ThisWorkbook.Worksheets("Registros").Cells(1, 1).CurrentRegion
    '
    Fila_Dest = Registros.Rows.Count + 1
    '
    With ThisWorkbook.Worksheets("Registros")
        Fila_Orig=12
        While ThisWorkbook.Sheets(1).Range("C" & Fila_Orig) <> Empty
            .Cells(Fila_Dest, 1).Value = ThisWorkbook.Sheets(1).Range("N8") 'Pedido
            .Cells(Fila_Dest, 2).Value = Date
            .Cells(Fila_Dest, 3).Value = ThisWorkbook.Sheets(1).Range("D2") 'Proyecto
            .Cells(Fila_Dest, 4).Value = ThisWorkbook.Sheets(1).Range("J2") 'Proveedor
            .Cells(Fila_Dest, 5).Value = ThisWorkbook.Sheets(1).Range("J3") 'R.F.C
 
            .Cells(Fila_Dest, 6).Value = ThisWorkbook.Sheets(1).Range("C" & Fila_Orig) 'Concepto
            .Cells(Fila_Dest, 7).Value = ThisWorkbook.Sheets(1).Range("G" & Fila_Orig) 'Unidad
            .Cells(Fila_Dest, 8).Value = ThisWorkbook.Sheets(1).Range("H" & Fila_Orig) 'Cantidad
            .Cells(Fila_Dest, 9).Value = ThisWorkbook.Sheets(1).Range("J" & Fila_Orig) 'Precio Unitario
            .Cells(Fila_Dest, 10).Value = ThisWorkbook.Sheets(1).Range("K" & Fila_Orig) 'Importe
 
            .Cells(Fila_Dest, 11).Value = ThisWorkbook.Sheets(1).Range("K32") 'Subtotal
            .Cells(Fila_Dest, 12).Value = ThisWorkbook.Sheets(1).Range("K33") 'IVA
            .Cells(Fila_Dest, 13).Value = ThisWorkbook.Sheets(1).Range("K36") 'Total
            .Cells(Fila_Dest, 14).Value = ThisWorkbook.Sheets(1).Range("D32") 'Observaciones
            Fila_Orig = Fila_Orig + 1
            Fila_Dest = Fila_Dest + 1
        Wend
    End With
    MsgBox "El registro se almaceno de manera exitosa.", vbInformation, strTitulo
End S

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
sin imagen de perfil

Codigo Macro de Excel almacenar registros

Publicado por Daniel (2 intervenciones) el 06/02/2024 22:59:51
Hola Antoni

Lo valide y funciona perfecto, agradezco mucho tu amable respuesta.

Saludos
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar