Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Un textbox en varias celdas para facturacion

dff1403

Por dff1403
en Macros y programación VBA

Recommended Posts

dff1403 Novato

dff1403

publicado
publicado

Estimados,

Segun el archivo adjunto lo que requiero saber es si es posible que con un textbox se pueda cargar la información (de modo multiline) pero en varias celdas , ya que si ingreso de este modo lo que hace es ir a la misma celda y no una debajo de otra.

Muchas Gracias por su apoyo y tiempo. Saludos

factura.zip

dff1403 Novato

dff1403

publicado
  • Autor
publicado

Hola Amigo, si que también debe agregar al costado de cantidad iría item No., ahora ese cuadro Descripción bebo ingresar Todos los item que deberán estar en las filas indicadas en el ejemplo, espero puedas ayudarme lo apreciaria mucho. Un saludo

dff1403 Novato

dff1403

publicado
  • Autor
publicado

Sería en este orden: Item/cantidad/descripción/unitario/total al ejemplo que me pasas solo le falta item. Y el tipo de moneda sería en esta forma por. Ejemplo: Son diez mil con 00/100 nuevos soles. Es esto posible? Saludos

tan178 Novato

tan178

publicado
publicado

Revise tu libro facturas ,solamente insertaste los textbox,listbox,label , la userform no tiene una sola sentencia, adjunto una guía de como empezar.

Private Sub txtDescripcion_Change()


End Sub


Private Sub txtIVA_Change()


End Sub


Private Sub txtNoFactura_Change()


End Sub

Private Sub UserForm_activate()


    Me.txtFecha.Text = Date ' para poner la fecha cuando se ejecute el form

Sheets("FACTURAS").Activate


End Sub


Private Sub lblRazon_Click()


End Sub

Private Sub cmdAceptar_Click()

    If MsgBox("Realizar la Compra?", vbQuestion + vbYesNo) = vbNo Then Exit Sub

    guardarFactura

    Cobrar.Show

    If Me.chkImprimir.value = True Then ImprimirFactura

End Sub


Private Sub cmdBuscar_Click()

    frmBuscarCliente.Show ' mostrar el formulario de buscar clientes

End Sub


Private Sub cmdProductos_Click()

    frmAgregarProducto.Show ' mostrar el formulario de agregar productos

End Sub


Private Sub Image2_Click()


End Sub

Private Sub lstDescripcion_Click()


End Sub


Private Sub lstImporte_Click()


End Sub


Private Sub lstPrecio_Click()


End Sub


Private Sub txtLetras_Change()


End Sub


Private Sub txtRazon_Change()


End Sub


Private Sub txtRFC_Change()


    Me.txtFecha.Text = Date ' para poner la fecha cuando se ejecute el form



End Sub


Public Sub sumarImporte() ' suma solo la ultima lista, osea, los importes

    Dim i As Integer

    Dim dTotal As Double

    Dim arrTotal As Variant

    dTotal = 0

    For i = 0 To Me.lstImporte.ListCount - 1

        dTotal = dTotal + Val(Me.lstImporte.List(i))

    Next

    Me.txtSubtotal.Text = dTotal

    If dTotal > 0 Then ' aqui se hacen los calculos para el subtotal, iva y total

        Me.txtIVA.Text = Round((Val(Me.txtSubtotal.Text) / 100) * 0, 0)

        Me.txtTotal.Text = Val(Me.txtSubtotal.Text) + Val(Me.txtIVA.Text)

    End If

    arrTotal = Split(Me.txtTotal.Text, ".")

    If UBound(arrTotal) = 0 Then

        Me.txtLetras.Text = "SON: " & Num2Text(arrTotal(0)) & " COLONES"

    Else

        Me.txtLetras.Text = "SON: " & Num2Text(arrTotal(0)) & " CON " & arrTotal(1) & "Colones."

    End If




End Sub


Private Sub guardarFactura()

Dim i As Integer

    Sheets("facturas").Activate ' activamos la hoja en la que vamos a trabajar

    If Trim(Range("A2").value) = "" Then ' localizamos la celda en donde vamos a empezar a insertar

        Range("A2").Activate

    Else

        Range("A1").End(xlDown)(xlDropDown).Activate

    End If


    For i = 0 To Me.lstCantidad.ListCount - 1

        ActiveCell.value = Me.txtNoFactura.Text ' insertamos los datos

        ActiveCell.Next.value = Me.txtFecha.Text

        ActiveCell.Next.Next.value = Me.cbcliente.Text

        ActiveCell.Next.Next.Next.value = Me.lstDescripcion.List(i)

        ActiveCell.Next.Next.Next.Next.value = Me.lstPrecio.List(i)

        ActiveCell.Next.Next.Next.Next.Next.value = Me.lstCantidad.List(i)

        ActiveCell.Next.Next.Next.Next.Next.Next.value = Me.lstImporte.List(i)

        descontarExistencia Me.lstDescripcion.List(i), Val(Me.lstCantidad.List(i))

        ActiveCell(xlDropDown).Activate

    Next

    Me.lstCantidad.Clear

    Me.lstImporte.Clear

    Me.lstDescripcion.Clear

    Me.lstPrecio.Clear

    Me.cbcliente.Text = ""

    Me.txtSubtotal.Text = ""


End Sub

Private Sub ImprimirFactura() ' esta hace lo mismo pero con la hoja de impresion

Dim i As Integer

    Sheets("IMPRESION").Activate

    Range("a1:h25").ClearContents

    Range("g2").value = Me.txtFecha.Text

    Range("C2").value = Me.cbcliente.Text

    Range("b8").Select

    For i = 0 To Me.lstCantidad.ListCount - 1

        ActiveCell.value = Me.lstCantidad.List(i)

        ActiveCell.Next.value = Me.lstDescripcion.List(i)

        ActiveCell.Next.Next.value = Me.lstPrecio.List(i)

        ActiveCell.Next.Next.Next.Next.value = Me.lstPrecio.List(i)

        ActiveCell.Next.Next.Next.Next.Next.value = Me.lstImporte.List(i)

        ActiveCell(xlDropDown).Activate

    Next

    Range("g19").value = Me.txtSubtotal.Text

    Range("g20").value = Me.txtIVA.Text

    Range("g21").value = Me.txtTotal.Text

    Range("b20").value = Me.txtLetras.Text

    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

End Sub


Private Sub descontarExistencia(ByVal sDescripcion As String, ByVal nCantidad As Integer)

    Dim sUltimaCelda As String

    Dim hojaActiva As String


    hojaActiva = ActiveSheet.Name  ' para recordar la hoja activa

    Sheets("PRODUCTOS").Activate ' nos pasamos a la hoja de productos


    ' aqui nomas fijamos los rangos, pa que no marque error si no hay nada en la lista

    If Trim(Range("b2").value) <> "" Then

        sUltimaCelda = Range("b1").End(xlDown).Address

    Else

        sUltimaCelda = "b2"

    End If


    'seleccionamos el rango de busqueda, para hacer mas rapido el proceso

    Range("b2:" & sUltimaCelda).Select


    ' esto es para localizar la clave que nos interesa... mmm estoy pensando que

    ' esta parte deberia ser mas corta.

    Selection.Find(What:=sDescripcion, After:=ActiveCell, LookIn:=xlValues _

      , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _

            xlNext, MatchCase:=False, SearchFormat:=False).Activate


    ' una vez localizada la clave, solo hacemos la resta

    With Me

            ActiveCell.Next.Next.value = Val(ActiveCell.Next.Next.value) - nCantidad

    End With


    'finalmente, regresamos a la hoja anterior, esto es para evitar errores

    ActiveWorkbook.Sheets(hojaActiva).Activate

End Sub

[/CODE]

tan178 Novato

tan178

publicado
publicado
Estimados,

Segun el archivo adjunto lo que requiero saber es si es posible que con un textbox se pueda cargar la información (de modo multiline) pero en varias celdas , ya que si ingreso de este modo lo que hace es ir a la misma celda y no una debajo de otra.

Muchas Gracias por su apoyo y tiempo. Saludos

Intenta hacer tus propios formularios ,que si tienes alguna duda te ayudaremos ,pero de mi parte archivos completos no voy a subir ,esfuérzate un poco que lo demás vendrá por añadidura.

Archivado

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

Ir al listado de temas

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

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


      • Sí
      • No
      • Ni me he fijado en ellos

  • Current Donation Goals

    • Mantenimiento de la comunidad
      Raised 0.00 EUR of 130.00 EUR target

  • Archivos

  • Estadísticas de descargas

    • Archivos
      187
    • Comentarios
      97
    • Revisiones
      29
    Más información sobre "Un juego del Rabino en Excel"
    Última descarga
    Un juego del Rabino en Excel
    Por pegones1

    2    1

  • Crear macros Excel

  • Mensajes

    • Oscar_MRF
      Contar días Consecutivos desde el último día.

      Por Oscar_MRF · publicado

      Que tal nuevamente,  adjunto una solución alternativa: =MAX(A:.A)-BYROW(F4:.AK20,LAMBDA(r,BUSCAR(2,1/(r=0),F3:.AK3))) Cabe mencionar que esta solución requiere funciones nuevas como RECORTAR.RANGO. CONTADOR FINAL (Solucion).xlsb
    • Tilin2023
      FORMULA MACRO PARA QUE LA FORMULA SIEMPRE TOME LA ULTIMA FILA Y COLUMNA DE UNA TABLA A PESAR QUE AUMENTE

      Por Tilin2023 · publicado

      Adjunto excel CONTADOR FINAL.xlsb
    • Tilin2023
      FORMULA MACRO PARA QUE LA FORMULA SIEMPRE TOME LA ULTIMA FILA Y COLUMNA DE UNA TABLA A PESAR QUE AUMENTE

      Por Tilin2023 · publicado

      Buenos días,  espero se encuentren bien de salud compañeros, Favor me podrían ayuda con lo siguientes como se podría hacer cuando tengo una tabla dinámica que  amedida que se aumente las columnas fechas con data un formula que se coloco al final busque o analice siempre la ultima fila y columna de la fecha. Coloco un ejemplo
    • Tilin2023
      COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

      Por Tilin2023 · publicado

      @JSDJSD Excelentes, GRACIAS POR TU SOPORTE , me ayudo demasiado es exactamente lo que quería. 5 ESTRELLAS
    • JSDJSD
      COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

      Por JSDJSD · publicado

      'Opción 1 Sub FiltrarSKUPorFecha(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim diccionarioSKU As Object Dim listaEliminar As Object Dim fechaActual As String, fechaSiguiente As String Dim f As Variant With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Crear diccionarios para comparar SKU y almacenar filas a eliminar Set diccionarioSKU = CreateObject("Scripting.Dictionary") Set listaEliminar = CreateObject("Scripting.Dictionary") ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then diccionarioSKU.RemoveAll ' Limpiar el diccionario antes de llenarlo ' Guardar los SKU de la fecha siguiente (solo de la siguiente) For f = fila + 1 To ultimaFila If .Cells(f, 1).Value <> fechaSiguiente Then Exit For diccionarioSKU(.Cells(f, 2).Value) = 1 Next f ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Solo eliminar si el SKU no está en la fecha siguiente If Not diccionarioSKU.exists(.Cells(f, 2).Value) Then listaEliminar(f) = 1 ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar.keys .Rows(f).Delete Next End With MsgBox "Completado correctamente.", vbInformation End Sub 'Opción 2 Sub FiltrarSKUPorFecha1(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim listaEliminar As Collection Dim fechaActual As String, fechaSiguiente As String Dim f As Variant, i As Long Dim SKUExiste As Boolean With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Inicializar la colección para marcar las filas a eliminar Set listaEliminar = New Collection ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Comprobar si el SKU está en la fecha siguiente SKUExiste = False For i = fila + 1 To ultimaFila If .Cells(i, 1).Value <> fechaSiguiente Then Exit For If .Cells(i, 2).Value = .Cells(f, 2).Value Then SKUExiste = True Exit For End If Next i ' Si el SKU no se encuentra en la fecha siguiente, marcar para eliminar If Not SKUExiste Then listaEliminar.Add f ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar .Rows(f).Delete Next f End With MsgBox "Completado correctamente.", vbInformation End Sub   TABLA ELIMINAR.xlsm

  • 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.