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

Respuesta
1

[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?

Has hecho algunos cambios con el cierre end if, copia como te envié

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

Y ahora LOS CAMPOS DE cantidad, prescricion, días, vía, no cargan tampoco

Tiene más código en tu botón o hay más

El código que te envié no es necesario el end if

Te paso el código completo + el tuyo

si no cloco el end if me sale error

q dice, " BLOQUE SIN END IF" 

Los datos de la prescricion y demás, ¿me los coloca a partir de la fila b27,,, por q?

Envíame tu archivo [email protected] para revisarlo saludos!

Ok, allí va,,,

No me enviaste tu archivo

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

Ya probé y su funciona saludos!

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,,,, 

Aquí esta la prueba de que te lo envíe,, más bien no lo has visto

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

¿Es decir con tu cosdigo NO coipia la fila 13 y las que le siguen,,, por q?

Falta adecuar el código para el resto de los textbox

mew gusta más tu código por que es más corto pero no funciona como debe ser..

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

Lastima hermano, tu código es corto,,,

Me hubiera ggustado implementarlo,,,

Pero bueno no se pudo

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

Después de la macro que te pasé, imprime y después borra

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

[Hola 

Crea una nueva pregunta para otra petición en el desarrollo de la pregunta pon para Adriel Ortiz y me explicas lo que deseas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas