Cargar datos a excel desde form vb
Tengo el sgt inconveniente
Desarrollo un aplicativo enexcel con forms visual,, todo lo manejo desde formularios, y el libro de excel donde se guardan los datos lo mantengo oculto, con la precaución de un botón para volver visible si se requiere hacer cambios de código, ok
Pero una de las hojas no la puedo programar por que los datos a insertar desde el form están en fila, no en columna,, pues es el folleto o la fórmula medica, envío la imagen adjunta,, como hago para insertar, la fecha, nombre, y edad, y cedula (identificación)
La parte de abajo ya si se puede hacer por columna, que es cantidad, prescripción, días, y vía administración... Y que desde el formulario se pueda imprimir y limpiar la hoja de la fórmula medica.
No logro hacerlo, adjunto la imagen,, estos botones que se ven en la imagen se eliminaran por que todo se va a ejecutar desde el form
gracias
Las líneas rojas es para detallar los campos donde se van a insertar los datos para poder después imprimir la formula,,.
1 Respuesta
[Hola
Te paso la macro para insertar tus datos del formulario a la hoja.
-No tendrás dificultades si la hoja esta oculta
-Cambia el nombre de la hoja por el tuyo.
-Cambias los nombres del textbox por el que tengas en tu formulario.
Private Sub CommandButton1_Click() Set h = Sheets("Hoja2") h.Visible = True ' Mostrar hoja h.[C8] = Date 'Fecha h.[C9] = TextBox1 'Nombre h.[10] = TextBox2 'Edad h.[E9] = TextBox3 'Identificación ' u = h.Range("A" & Rows.Count).End(xlUp).Row + 1 h.Cells(u, "B") = TextBox4 ' Cantidad h.Cells(u, "C") = TextBox5 ' Preescripción h.Cells(u, "D") = TextBox6 ' Días h.Cells(u, "E") = TextBox7 ' Vía ' h.Visible = False ' ocultar hoja End Sub
si tienes dificultades en adecuar la macro envíame tu archivo a [email protected]
Valora la respuesta para finalizar saludos!
Tus datos lo insertas en la columnas B
Actualizas esta línea.
u = h.Range("A" & Rows.Count).End(xlUp).Row + 1
por esta
u = h.Range("B" & Rows.Count).End(xlUp).Row + 1
HOLA ADRIEL
implmente tu código y fue muy satisfactorio,, excelente, gracias, pero hay un pqñ inconveniente
Los datos de cita- prescripion - días, - vía, me lo inserta a partir de la fila
-c13-b13-d13-e13 y deberia ser apartir de la fila 12,,,,
creo q es la instrucion , el + 1
Q modifico para q mw la inserte apartir d ela 12, de resto todo bien, solo falta habilitar el printout y listo.
Y lo otro es q si esa información de la fórmula se puede copiar en otra hoja, te mando la imagen de la otra hoja para
copiar los datos de la formulay quede almacenada
u = h.Range("B" & Rows.Count).End(xlUp).Row + 1
Te paso la macro actualizada, para copiar a partir de la fila 12
Private Sub CommandButton1_Click() Set h = Sheets("Hoja2") h.Visible = True ' Mostrar hoja h.[C8] = Date 'Fecha h.[C9] = TextBox1 'Nombre h.[10] = TextBox2 'Edad h.[E9] = TextBox3 'Identificación ' u = h.Range("B" & Rows.Count).End(xlUp).Row + 1 If u < 12 Then u = 12 ' h.Cells(u, "B") = TextBox4 ' Cantidad h.Cells(u, "C") = TextBox5 ' Preescripción h.Cells(u, "D") = TextBox6 ' Días h.Cells(u, "E") = TextBox7 ' Vía ' h.Visible = False ' ocultar hoja End Sub
valora la respuesta para finalizar saludos!
Crea una nueva pregunta para la otra consulta y cuenta con mi apoyo.
Ahora el botón no anexa ni imprime,,, no da error pero al pulsaer el botón no hace nada, ¿SERA EL end if?
si lo copio no ingresa y tampoco imprime,, tuve q colocar el end if debajo de esta instrucion..
Y cuando ingresan los datos estos se subrayan, sobre todo la prescripción,, y no debe lllevar rayas
If u < 12 Then u = 12
Envíame tu archivo [email protected] para revisarlo saludos!
Te paso otra macro
Private Sub CommandButton1_Click() Set h = Sheets("Hoja2") h.Visible = True ' Mostrar hoja h.[C8] = Date 'Fecha h.[C9] = TextBox1 'Nombre h.[10] = TextBox2 'Edad h.[E9] = TextBox3 'Identificación ' f = 12 Do While h.Cells(f, "B") <> "" f = f + 1 Loop ' h.Cells(f, "B") = TextBox4 ' Cantidad h.Cells(f, "C") = TextBox5 ' Preescripción h.Cells(f, "D") = TextBox6 ' Días h.Cells(f, "E") = TextBox7 ' Vía ' h.Visible = False ' ocultar hoja End Sub
claro q si,, te lo envie
de todos modos al ver q te demorabas implemente otro codigo,, mas largo pero me funciona,,
Si llegó tu archivo disculpa.
Te paso la macro. Con esto no tendrás problemas
Valora la respuesta para finalizar.
Private Sub CommandButton1_Click() Set h = Sheets("Hoja2") h.Visible = True ' Mostrar hoja h.[C8] = Date 'Fecha h.[C9] = TextBox1 'Nombre h.[10] = TextBox2 'Edad h.[E9] = TextBox3 'Identificación ' f = 12 Do While h.Cells(f, "B") <> "" f = f + 1 Loop ' h.Cells(f, "B") = TextBox4 ' Cantidad h.Cells(f, "C") = TextBox5 ' Preescripción h.Cells(f, "D") = TextBox6 ' Días h.Cells(f, "E") = TextBox7 ' Vía ' h.Visible = False ' ocultar hoja End Sub
Hermano gracias,,, ya implente otro código,
El tuyo no no fue muy funcional, no te procupe por la calificación, o importsnte es el intento.. ya entregue la pc.
. Te envío una foto con el código que tu me diste,, donde están los demás datos,, ¿no los copia,, te fijaste? ¿La fila 13 donde esta? si en el form esta digitado e ingresado,,,,
Te muestro el código tuve que implementar
Private Sub CommandButton1_Click()
'Inserta fila
Selection.EntireRow.Insert
'LimpiaLimpia Los Textbox
TextBox1 = Empty
TextBox2 = Empty
TextBox3 = Empty
TextBox4 = Empty
TextBox5 = Empty
'Envia el cursor al Textbox1 para volver a capturar los datos
TextBox1.SetFocus
End Sub
Private Sub TextBox1_Change()
Range("c8").Select
ActiveCell.FormulaR1C1 = TextBox1
End Sub
Private Sub TextBox2_Change()
Range("c9").Select
ActiveCell.FormulaR1C1 = TextBox2
End Sub
Private Sub TextBox3_Change()
Range("c10").Select
ActiveCell.FormulaR1C1 = TextBox3
End Sub
Private Sub TextBox4_Change()
Range("e9").Select
ActiveCell.FormulaR1C1 = TextBox4
End Sub
Private Sub TextBox5_Change()
Range("b12").Select
ActiveCell.FormulaR1C1 = TextBox5
End Sub
Private Sub TextBox6_Change()
Range("c12").Select
ActiveCell.FormulaR1C1 = TextBox6
End Sub
Private Sub TextBox7_Change()
Range("d12").Select
ActiveCell.FormulaR1C1 = TextBox7
End Sub
Private Sub TextBox8_Change()
Range("e12").Select
ActiveCell.FormulaR1C1 = TextBox8
End Sub
Private Sub TextBox9_Change()
Range("b13").Select
ActiveCell.FormulaR1C1 = TextBox9
End Sub
Private Sub TextBox10_Change()
Range("c13").Select
ActiveCell.FormulaR1C1 = TextBox10
End Sub
Private Sub TextBox11_Change()
Range("d13").Select
ActiveCell.FormulaR1C1 = TextBox11
End Sub
Private Sub TextBox12_Change()
Range("e13").Select
ActiveCell.FormulaR1C1 = TextBox12
End Sub
Private Sub TextBox13_Change()
Range("b14").Select
ActiveCell.FormulaR1C1 = TextBox13
End Sub
Private Sub TextBox14_Change()
Range("c14").Select
ActiveCell.FormulaR1C1 = TextBox14
End Sub
Private Sub TextBox15_Change()
Range("d14").Select
ActiveCell.FormulaR1C1 = TextBox15
End Sub
Private Sub TextBox16_Change()
Range("e14").Select
ActiveCell.FormulaR1C1 = TextBox16
End Sub
Private Sub TextBox17_Change()
Range("b15").Select
ActiveCell.FormulaR1C1 = TextBox17
End Sub
Private Sub TextBox18_Change()
Range("c15").Select
ActiveCell.FormulaR1C1 = TextBox18
End Sub
Private Sub TextBox19_Change()
Range("d15").Select
ActiveCell.FormulaR1C1 = TextBox19
End Sub
Private Sub TextBox20_Change()
Range("e15").Select
ActiveCell.FormulaR1C1 = TextBox20
End Sub
Private Sub TextBox21_Change()
Range("b16").Select
ActiveCell.FormulaR1C1 = TextBox21
End Sub
Private Sub TextBox22_Change()
Range("c16").Select
ActiveCell.FormulaR1C1 = TextBox22
End Sub
Private Sub TextBox23_Change()
Range("d16").Select
ActiveCell.FormulaR1C1 = TextBox23
End Sub
Private Sub TextBox24_Change()
Range("e16").Select
ActiveCell.FormulaR1C1 = TextBox24
End Sub
Private Sub TextBox25_Change()
Range("b17").Select
ActiveCell.FormulaR1C1 = TextBox25
End Sub
Private Sub TextBox26_Change()
Range("c17").Select
ActiveCell.FormulaR1C1 = TextBox26
End Sub
Private Sub TextBox27_Change()
Range("d17").Select
ActiveCell.FormulaR1C1 = TextBox27
End Sub
Private Sub TextBox28_Change()
Range("e17").Select
ActiveCell.FormulaR1C1 = TextBox28
End Sub
Private Sub TextBox29_Change()
Range("b18").Select
ActiveCell.FormulaR1C1 = TextBox29
End Sub
Private Sub TextBox30_Change()
Range("c18").Select
ActiveCell.FormulaR1C1 = TextBox30
End Sub
Private Sub TextBox31_Change()
Range("d18").Select
ActiveCell.FormulaR1C1 = TextBox31
End Sub
Private Sub TextBox32_Change()
Range("e18").Select
ActiveCell.FormulaR1C1 = TextBox32
End Sub
Private Sub TextBox33_Change()
Range("b18").Select
ActiveCell.FormulaR1C1 = TextBox29
End Sub
Private Sub TextBox30_Change()
Range("c18").Select
ActiveCell.FormulaR1C1 = TextBox30
End Sub
Private Sub TextBox31_Change()
Range("d18").Select
ActiveCell.FormulaR1C1 = TextBox31
End Sub
Private Sub TextBox32_Change()
Range("e18").Select
ActiveCell.FormulaR1C1 = TextBox32
End Sub
ahhhh,, osa repetir la instrucción
Voy a probar aver
h.Cells(f, "B") = TextBox4 ' Cantidad h.Cells(f, "C") = TextBox5 ' Preescripción h.Cells(f, "D") = TextBox6 ' Días h.Cells(f, "E") = TextBox7 ' Vía
Así :
Private Sub CommandButton1_Click()
Set h = Sheets("formula")
h.Visible = True ' Mostrar hoja
h.[C8] = Date 'Fecha
h.[C9] = TextBox2 'Nombre
h.[C10] = TextBox3 'Edad
h.[E9] = TextBox4 'Identificación
'
f = 12
Do While h.Cells(f, "B") <> ""
f = f + 1
Loop
'
h.Cells(f, "B") = TextBox5 ' Cantidad
h.Cells(f, "C") = TextBox6 ' Preescripción
h.Cells(f, "D") = TextBox7 ' Días
h.Cells(f, "E") = TextBox8 ' Vía
h.Cells(f, "B") = TextBox9 ' Cantidad
h.Cells(f, "C") = TextBox10 ' Preescripción
h.Cells(f, "D") = TextBox11 ' Días
h.Cells(f, "E") = TextBox12 ' Vía
h.Cells(f, "B") = TextBox13 ' Cantidad
h.Cells(f, "C") = TextBox14 ' Preescripción
h.Cells(f, "D") = TextBox15 ' Días
h.Cells(f, "E") = TextBox16 ' Vía
h.Cells(f, "B") = TextBox17 ' Cantidad
h.Cells(f, "C") = TextBox18 ' Preescripción
h.Cells(f, "D") = TextBox19 ' Días
h.Cells(f, "E") = TextBox20 ' Vía
Solo me copia la ultima instrucción pero no todas
Te paso la macro actualizada
Private Sub CommandButton1_Click() If TextBox2 = "" Then MsgBox "No Has Digitado ningun dato", vbOKOnly + vbInformation, "AVISO" Exit Sub TextBox2.SetFocus End If Set h = Sheets("formula") h.Visible = True ' Mostrar hoja h.[C8] = Date 'Fecha h.[C9] = TextBox2 'Nombre h.[C10] = TextBox3 'Edad h.[E9] = TextBox4 'Identificación ' f = 12 Do While h.Cells(f, "B") <> "" f = f + 1 Loop ' h.Cells(f, "B") = TextBox5 ' Cantidad h.Cells(f, "C") = TextBox6 ' Preescripción h.Cells(f, "D") = TextBox7 ' Días h.Cells(f, "E") = TextBox8 ' Vía ' h.Cells(f + 1, "B") = TextBox9 ' Cantidad h.Cells(f + 1, "C") = TextBox10 ' Preescripción h.Cells(f + 1, "D") = TextBox11 ' Días h.Cells(f + 1, "E") = TextBox12 ' Vía ' h.Cells(f + 2, "B") = TextBox13 ' Cantidad h.Cells(f + 2, "C") = TextBox14 ' Preescripción h.Cells(f + 2, "D") = TextBox15 ' Días h.Cells(f + 2, "E") = TextBox16 ' Vía ' h.Cells(f + 3, "B") = TextBox17 ' Cantidad h.Cells(f + 3, "C") = TextBox18 ' Preescripción h.Cells(f + 3, "D") = TextBox19 ' Días h.Cells(f + 3, "E") = TextBox20 ' Vía ' h.Cells(f + 4, "B") = TextBox21 ' Cantidad h.Cells(f + 4, "C") = TextBox22 ' Preescripción h.Cells(f + 4, "D") = TextBox23 ' Días h.Cells(f + 4, "E") = TextBox24 ' Vía ' h.Cells(f + 5, "B") = TextBox25 ' Cantidad h.Cells(f + 5, "C") = TextBox26 ' Preescripción h.Cells(f + 5, "D") = TextBox27 ' Días h.Cells(f + 5, "E") = TextBox28 ' Vía ' h.Cells(f + 6, "B") = TextBox29 ' Cantidad h.Cells(f + 6, "C") = TextBox30 ' Preescripción h.Cells(f + 6, "D") = TextBox31 ' Días h.Cells(f + 6, "E") = TextBox32 ' Vía ' h.Cells(f + 7, "B") = TextBox33 ' Cantidad h.Cells(f + 7, "C") = TextBox34 ' Preescripción h.Cells(f + 7, "D") = TextBox35 ' Días h.Cells(f + 7, "E") = TextBox36 ' Vía ' h.Visible = True ' ocultar hoja ' Hoja4. PrintOut 'Hoja4. Protect Unload Me End Sub
valora la respuesta para finalizar saludos!
implemente este codigo debajo de tu macro,, esta ultima q escribes aqui.,
Range("c8,c9,C10,e9,B12:E25").ClearContents
,, y despues
el printout
estara bien,? como no tengo impresora no puedo probar
Hola
No se que paso pero ahora no me coloca los datos después de elegirlos en el combobox1
Puse este código
For Fila = 5 To 1000
If Hoja1.Cells(Fila, 3) = "" Then
Final = Fila - 1
Exit For
End If
Next
For Fila = 5 To Final
If ComboBox1 = Hoja1.Cells(Fila, 3) Then
Me.TextBox3 = Hoja1.Cells(Fila, 5)
Me.TextBox4 = Hoja1.Cells(Fila, 2)
Exit For
End If
Next
end Sub
- Compartir respuesta