Jump to content

Antoni

Members
  • Posts

    11,361
  • Joined

  • Last visited

  • Days Won

    796

Everything posted by Antoni

  1. He hecho un pequeño retoque en los procedimientos de modificar, insertar y doble_click en la lista. Probado., Ordenes v1.0.0 (1).xlsm
  2. ¿Has probado simplemente así? Sql = Sql & ActiveCell.Offset(0, 8) & ","
  3. No se entiende que es lo que quieres hacer y además el proyecto VBA está protegido.
  4. Pon las imágenes en la carpeta D:\Ordenes\Fotos con el nombre del ID (1.jpg, 2.jpg, 3.jpg, ........) Al seleccionar cualquier celda del rango, se actualizará la imagen del control Image Activex que he añadido en la hoja. Ordenes v1.0.0.xlsm
  5. Sub CompararPrecios() Dim celda As Range, factura As Worksheet, x As Long Dim precio As Worksheet, resultado As Worksheet, fila As Long '-- Application.ScreenUpdating = False Set factura = Sheets("factura") Set precio = Sheets("precio") Set resultado = Sheets("resultado") '-- With precio .Range(.Range("B1"), .Range("B1").End(xlDown)).Interior.ColorIndex = xlNone End With resultado.Cells.ClearContents With factura .Range(.Range("B1"), .Range("B1").End(xlDown)).Interior.ColorIndex = xlNone For x = 1 To .Range("A" & Rows.Count).End(xlUp).Row Set celda = precio.Columns("A").Find(.Range("A" & x)) If Not celda Is Nothing Then If Not .Range("B" & x) = celda.Offset(, 1) Then .Range("B" & x).Interior.Color = vbYellow celda.Offset(, 1).Interior.Color = vbYellow fila = fila + 1 resultado.Range("A" & fila) = .Range("A" & x) resultado.Range("B" & fila) = .Range("B" & x) resultado.Range("C" & fila) = celda.Offset(, 1) End If End If Next End With '-- If fila = 0 Then MsgBox "*** SIN INCIDENCIAS ***", vbInformation Else MsgBox "*** DETECTADAS " & fila & " INCIDENCIAS ***", vbExclamation resultado.Select End If End Sub Comparacion.xlsm
  6. Se supone que el dato buscado es una fecha, prueba así: Me.LblVence.Caption = Format(Application.WorksheetFunction.VLookup(Me.CmbNTarjeta.Text, Hoja5.Range("I:K"), 3, 0), "mm/yy")
  7. Sin el archivo y con un ejemplo de lo que quieres, imposible ayudarte
  8. No se si lo he entendido, si no es así, tendrás que subir el archivo y poner un ejemplo de lo que quieres. Public Sub enviar_datos() Application.ScreenUpdating = False Dim celda As Range With Sheets("TABLA_DATOS") For Each celda In Sheets("PLANTILLA").Range("E7:E34") If Not celda = 0 Then .Range("A2").EntireRow.Insert .Range("A2") = Sheets("PLANTILLA").Range("D4") .Range("B2") = Sheets("PLANTILLA").Range("F3") .Range("C2") = Sheets("PLANTILLA").Range("I3") .Range("D2") = Sheets("PLANTILLA").Range("I4") .Range("E2") = Sheets("PLANTILLA").Cells(celda.Row, "E") .Range("F2") = Sheets("PLANTILLA").Cells(celda.Row, "D") .Range("G2") = Sheets("PLANTILLA").Cells(celda.Row, "C") .Range("H2") = Sheets("PLANTILLA").Cells(celda.Row, "B") .Range("I2") = Sheets("PLANTILLA").Cells(celda.Row, "A") End If Next End With Application.ScreenUpdating = True End Sub
  9. Esta función compara palabras y puedes usarla así: =ComparaNombre(A2;B2) Function ComparaNombre(A As String, B As String) As Boolean a1 = Split(A, " ") b1 = Split(B, " ") If UBound(a1) = UBound(b1) Then For x = 0 To UBound(a1) For y = 0 To UBound(b1) If UCase(a1(x)) = UCase(b1(y)) Then t = t + 1 Next Next If t = UBound(a1) + 1 Then ComparaNombre = True End If End Function
  10. Efectivamente, tal como se ve en tu imagen, estás dentro de un módulo de hoja. (Se observa Private Sub Worksheet_Activate())
  11. Prueba con esta macro: Sub ÚltimaFecha() fecha = InputBox("Introduzca fecha a buscar (dd/mm/aaaa)") If IsDate(fecha) Then fecha = CDate(fecha) For x = Hoja1.Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1 If Hoja1.Range("A" & x) = fecha Then Hoja1.Range("A" & x).Select MsgBox "Fecha " & fecha & " encontrada en la fila " & x, vbInformation Exit Sub End If Next MsgBox "La fecha " & fecha & " no existe", vbExclamation End If End Sub
  12. Prueba el formulario FrmRetenciones a ver si es lo que quieres, si no es eso, es que no he entendido nada. Comprobante de Nóminas.xlsm
  13. Prueba el adjunto. También he modificado el procedimiento Initialize del formulario para cambiar la forma de llenado de la lista. Asistencia (2).xlsm
  14. Las celdas no se pueden ocultar, solo se pueden ocultar filas y columnas. Sube un archivo y pon un ejemplo de lo que pretendes hacer.
  15. Así me ha funcionado: sql = "SELECT Correlativo, C_1, C_2, C_5, C_6, C_7, C_8, C_9, C_10, C_11, C_13, C_14, RUC, Resp FROM Tb_Registros " & _ " WHERE C_2 Like '*" & UCase(Trim(Cmb_Suc)) & "*' AND C_1 BETWEEN #" & _ Format(CDate(Txt_FechaInicial.Value), "mm/dd/yyyy") & "# AND #" & _ Format(CDate(Txt_FechaFinal.Value), "mm/dd/yyyy") & "#"
  16. Private Sub txtValorPresupUsd_Change() Dim ValorPresupUsd As Double Dim ValorPresup As Double Dim Cotiz1 As Double '-- If IsNumeric(txtValorPresup) And IsNumeric(txtCotiz1) Then ValorPresup = CDbl(txtValorPresup) Cotiz1 = CDbl(txtCotiz1) If Cotiz1 > 0 Then ValorPresupUsd = ValorPresup / Cotiz1 txtValorPresupUsd = Format(ValorPresupUsd, "#,##0.00") End If End If End Sub
  17. Aquí ya es hora de cenar, si no te contesta nadie esta noche, mañana le echo un vistazo.
×
×
  • Create New...

Important Information

Privacy Policy