Jump to content

rolano

Members
  • Content Count

    1,170
  • Joined

  • Last visited

  • Days Won

    8

rolano last won the day on December 8 2018

rolano had the most liked content!

1 Follower

About rolano

  • Rank
    César Rolando
  • Birthday 10/24/1973

Contact Methods

  • Website URL
    http://excelilove.blogspot.com/
  • Facebook
    tiradocesar@outlook.com
  • Twitter
    Cesar_Tirado

Profile information

  • Gender
    Hombre
  • Localización:
    Perú
  • Interests
    Ajedrez y Baloncesto

Converted

  • Campos
    ;

Recent Profile Visitors

639 profile views
  1. Sub Consulta_Registros() Dim conexion As ADODB.Connection Dim recordset As ADODB.recordset Dim Consulta As String Dim MiBase As String Set conexion = New ADODB.Connection MiBase = "\DBClientes.accdb" conexion.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Application.ThisWorkbook.Path & Application.PathSeparator & MiBase Consulta = "SELECT * FROM TClientes " Set recordset = New ADODB.recordset recordset.Open Consulta, conexion, adOpenKeySet, adLockOptimistic, adCmdTableDirect Dim total_reg As Integer UserForm1.TextBox1.Value = recordset.RecordCount total_reg = 0 Set recordset = Nothing Set conexion = Nothing End Sub Hola a todos, mangelperu, así también puede funciona. Saludos, César
  2. Hola Milton, esta mal escrito celda.seletc debe de decir celda.select. Tu formato de celda ( rango C5:C10) esta como texto, cambio a general. Saludos,
  3. Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$J$7" Then If UCase(Target.Value) = "JUAN" Then Macro1 ElseIf UCase(Target.Value) = "MARIA" Then Macro2 End If End If If Target.Address = "$J$9" Then If UCase(Target.Value) = "HOMBRE" Then Macro11 ElseIf UCase(Target.Value) = "MUJER" Then Macro12 End If End If End Sub Sub Macro1() Range("J21").Value = "Debo decir Juan" ActiveSheet.Range("$J$9").Calculate Range("A1").Select End Sub Sub Macro2() Range("J21").Value = "Debo decir Maria" Range("A1").Select End Sub Sub Macro11() Range("J23").Value = "Esto es porque has dicho Juan" Range("A1").Select End Sub Sub Macro12() Range("J23").Value = "Esto es porque has dicho Maria" Range("A1").Select End Sub
  4. Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$J$7" Then If UCase(Target.Value) = "JUAN" Then Macro1 ElseIf UCase(Target.Value) = "MARIA" Then Macro2 End If End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$J$7" Then If UCase(Target.Value) = "JUAN" Then Macro1 ElseIf UCase(Target.Value) = "MARIA" Then Macro2 End If End If End Sub Sub Macro1() Genero = InputBox(Genero, "GENERO") Range("J9").Value = Genero Range("J21").Value = "Debo decir Juan" ActiveSheet.Range("$J$9").Calculate If Range("J9").Value = "HOMBRE" Then Macro11 ElseIf Range("J9").Value = "MUJER" Then Macro12 End If Range("A1").Select End Sub Sub Macro2() Genero = InputBox(Genero, "GENERO") Range("J9").Value = Genero Range("J21").Value = "Debo decir Maria" If Range("J9").Value = "HOMBRE" Then Macro11 ElseIf Range("J9").Value = "MUJER" Then Macro12 End If Range("A1").Select End Sub Sub Macro11() Range("J23").Value = "Esto es porque has dicho Juan" Range("A1").Select End Sub Sub Macro12() Range("J23").Value = "Esto es porque has dicho Maria" Range("A1").Select End Sub Texto Prueba 1.xlsm
  5. Hola, sube un archivo de muestra. Recuerda que el código tiene que estar en la hoja que estas trabajando
  6. Dim C As Range, mPath$ Image1.Picture = LoadPicture("") Set C = Hoja8.Range("a1").CurrentRegion.Columns(2).Find(ComboBox1, , LookIn:=xlValues, LookAt:=xlPart)'<--Cambia a XlPart' If C Is Nothing Then Exit Sub Worksheets("inventario").Visible = True Worksheets("inventario").Select C.Select mPath = ThisWorkbook.path & "\imagenes\" mPath = mPath & Dir(mPath & Format(C.Offset(, -1), "FEC-" & "0000") & ".*") if mPath<>"" then Image1.Picture = LoadPicture(mPath) Else Image1.Picture = LoadPicture(ThisWorkbook.path & "\imagenes\FEC-000000.JPG") 'MsgBox "No se encuentra la imagen" Exit Sub End If
  7. Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$J$7" Then If UCase(Target.Value) = "JUAN" Then Macro1 ElseIf UCase(Target.Value) = "MARIA" Then Macro2 End If End If End Sub Sub Macro1() Range("J9").Value = "HOMBRE" Range("J21").Value = "Debo decir Juan" ActiveSheet.Range("$J$9").Calculate If Range("J9").Value = "HOMBRE" Then Macro11 ElseIf Range("J9").Value = "MUJER" Then Macro12 End If Range("A1").Select End Sub Sub Macro2() Range("J9").Value = "MUJER" Range("J21").Value = "Debo decir Maria" If Range("J9").Value = "HOMBRE" Then Macro11 ElseIf Range("J9").Value = "MUJER" Then Macro12 End If Range("A1").Select End Sub Sub Macro11() Range("J23").Value = "Esto es porque has dicho Juan" Range("A1").Select End Sub Sub Macro12() Range("J23").Value = "Esto es porque has dicho Maria" Range("A1").Select End Sub Hola Juan, revisa el código
  8. Private Sub CommandButton2_Click() On Error Resume Next Dim b As Object Dim a As Object Dim dato0 Dim dato1 Dim dato2 Dim fila As Integer Dim i As Integer Dim uf As String Dim uc As String Dim wc As String Dim strg As String Set b = Sheets("Resguardo") uf = b.Range("A" & Rows.Count).End(xlUp).Row dato1 = VBA.CDate(TextBox2) dato2 = VBA.CDate(TextBox3) If dato2 = "" Or dato1 = "" Then MsgBox ("Debe ingresar datos para consulta entre rango de fechas"), vbCritical, "AVISO" Exit Sub End If If dato2 < dato1 Then MsgBox ("La fecha final no puede ser mayor a la fecha inicial"), vbCritical, "AVISO" Exit Sub End If b.AutoFilterMode = False Me.ListBox1 = "Clear" Me.ListBox1.RowSource = "Clear" 'Elimina hoja y crea hoja dando el mismo nombre que la eliminada Sheets("Temporal").Delete ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) ActiveSheet.Name = "Temporal" Set a = Sheets("Temporal") b.Range("A1:I1").Copy Destination:=a.Range("A1") fila = 2 If dato2 < dato1 Then MsgBox ("La fecha final no puede ser mayor a la fecha inicial"), vbCritical, "AVISO" Exit Sub End If For i = 2 To uf strg = b.Cells(i, 7).Value dato0 = VBA.CDate(b.Cells(i, 6).Value) If VBA.UCase(strg) Like VBA.UCase(TextBox1.Value) & "*" And dato0 >= dato1 And dato0 <= dato2 Then a.Cells(fila, 1) = b.Cells(i, 1) a.Cells(fila, 2) = b.Cells(i, 2) a.Cells(fila, 3) = b.Cells(i, 3) a.Cells(fila, 4) = b.Cells(i, 4) a.Cells(fila, 5) = b.Cells(i, 5) a.Cells(fila, 6) = VBA.Format(b.Cells(i, 6), "mm/dd/yyyy;@") a.Cells(fila, 7) = b.Cells(i, 7) a.Cells(fila, 8) = b.Cells(i, 8) a.Cells(fila, 9) = b.Cells(i, 9) fila = fila + 1 End If Next i a.Range("I").NumberFormat = VBA.Format("dd/mm/yyyy") With Sheets("Temporal") ListBox1.List = .Range("a2", .[i2].End(xlDown)).Value End With TextBox1.SetFocus End Sub Private Sub CommandButton3_Click() Dim sino As String sino = MsgBox("Estas seguro de cerrar la Busqueda de Resguardo, antes debes guardar?", vbYesNo + vbQuestion, "CONFIRMA") If sino <> vbYes Then Exit Sub Application.ScreenUpdating = False Application.Visible = False 'Application.Windows(ThisWorkbook.Name).Visible = False Worksheets("Temporal").Select Worksheets("Temporal").Delete Unload Me 'Menu.Show Application.ScreenUpdating = True End Sub Private Sub CommandButton4_Click() Dim h1 As Object Dim C As Integer Dim f As Integer Set h1 = Sheets("ReporteResguardo") h1.Rows("2:" & Rows.Count).ClearContents C = ListBox1.ColumnCount f = ListBox1.ListCount h1.Range(h1.Cells(2, "A"), h1.Cells(f + 1, C)) = ListBox1.List MsgBox ("Los datos se copiaron con éxito"), vbInformation, "AVISO" CommandButton3.Visible = True End Sub Private Sub CommandButton5_Click() Application.Help ThisWorkbook.Path & "\Ayuda.chm" End Sub Private Sub CommandButton6_Click() EliminarFilas2.Show End Sub Private Sub DTPicker1_Change() TextBox2 = DTPicker1 End Sub Private Sub DTPicker2_Change() TextBox3 = DTPicker2 End Sub Private Sub ListBox1_Click() CommandButton6.Visible = True End Sub Private Sub TextBox1_Change() Application.DisplayAlerts = False Application.ScreenUpdating = False On Error Resume Next Dim b As Object Dim a As Object Dim dato0 Dim dato1 Dim dato2 Dim fila As Integer Dim i As Integer Dim uf As String Dim uc As String Dim wc As String Dim strg As String Set b = Sheets("Resguardo") uf = b.Range("A" & Rows.Count).End(xlUp).Row If VBA.Trim(TextBox1.Value) = "" Then With Sheets("Resguardo") ListBox1.List = .Range("a2", .[i2].End(xlDown)).Value End With Exit Sub End If b.AutoFilterMode = False Me.ListBox1 = "Clear" Me.ListBox1.RowSource = "Clear" dato1 = VBA.CDate(TextBox2) dato2 = VBA.CDate(TextBox3) 'Elimina hoja y crea hoja dando el mismo nombre que la eliminada Sheets("Temporal").Delete ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) ActiveSheet.Name = "Temporal" Set a = Sheets("Temporal") b.Range("A1:I1").Copy Destination:=a.Range("A1") fila = 2 For i = 2 To uf strg = b.Cells(i, 7).Value If VBA.UCase(strg) Like VBA.UCase(TextBox1.Value) & "*" Then a.Cells(fila, 1) = b.Cells(i, 1) a.Cells(fila, 2) = b.Cells(i, 2) a.Cells(fila, 3) = b.Cells(i, 3) a.Cells(fila, 4) = b.Cells(i, 4) a.Cells(fila, 5) = b.Cells(i, 5) a.Cells(fila, 6) = VBA.Format(b.Cells(i, 6), "mm/dd/yyyy;@") a.Cells(fila, 7) = b.Cells(i, 7) a.Cells(fila, 8) = b.Cells(i, 8) a.Cells(fila, 9) = b.Cells(i, 9) fila = fila + 1 End If Next i a.Range("I").NumberFormat = VBA.Format("dd/mm/yyyy") With Sheets("Temporal") ListBox1.List = .Range("a2", .[i2].End(xlDown)).Value End With End Sub Private Sub UserForm_Initialize() 'Dim b As Object 'Dim uf As Integer 'Dim uc, wc As String ' Application.DisplayAlerts = False Application.ScreenUpdating = False With Sheets("Resguardo") ListBox1.List = .Range("a2", .[i2].End(xlDown)).Value End With Application.DisplayAlerts = True Application.ScreenUpdating = True 'Al iniciar el formulario asignamos un mensaje tooltip al botón, 'así como un ícono personalizado para ser mostrado en over Me.CommandButton5.ControlTipText = "Mostrar la ayuda de este formulario." Me.CommandButton5.MousePointer = fmMousePointerHelp CommandButton3.Visible = False CommandButton6.Visible = False End Sub ' 'Evita Cerrar La Ventana Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = 0 Then MsgBox "Use el botón Cerrar del formulario", vbInformation, " Botón No Disponible " Cancel = 1 CloseMode = 1 End If End Sub Private Sub UserForm_Activate() Application.ScreenUpdating = False Application.Visible = False TextBox1 = Empty TextBox1.SetFocus Application.ScreenUpdating = True ' DTPicker1.Value = VBA.Date ' TextBox2.Value = DTPicker1.Value ' DTPicker2.Value = VBA.Date ' TextBox3.Value = DTPicker2.Value CommandButton3.Visible = False CommandButton6.Visible = False End Sub Sub eliminarProducto() 'Borrar del ListBox y de las hojas On Error Resume Next Dim sino As String sino = MsgBox("Estás seguro de Eliminar el Articulo seleccionado?", vbYesNo + vbQuestion, "CONFIRMA") If sino <> vbYes Then Exit Sub Dim fila As Integer Dim Final As Integer Dim Cantidad As Integer ''''AQUI REGISTRO EL CORRELATIVO FINAL PROCESADO Application.ScreenUpdating = False Dim NombreHoja As String NombreHoja = "Inventario" 'Buscamos la última fila 'EN EL SIGUIENTE ME ESTOY REFIRIENDO A LA HOJA SEGUN EL SECTOR fila = 2 Do While ThisWorkbook.Sheets(NombreHoja).Cells(fila, 1) <> "" fila = fila + 1 Loop Final = fila 'CON ESTE CODIGO ESTARE RESTANDO "1" AL FOLIO EN CASO SE REGRESE A LA VENTANA ANTERIOR For fila = 2 To Final If ThisWorkbook.Sheets(NombreHoja).Cells(fila, 1) = ListBox1.List(ListBox1.ListIndex, 0) Then 'CORRESPONDE A LA COLUMNA "A" ThisWorkbook.Sheets(NombreHoja).Cells(fila, 8) = ThisWorkbook.Sheets(NombreHoja).Cells(fila, 7) - Val(ListBox1.List(ListBox1.ListIndex, 5)) Exit For End If Next '///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// Dim row_LB& With Busqueda_Resguardo.ListBox1 row_LB = .ListIndex If row_LB = -1 Then Exit Sub Hoja3.Activate ' Se busca por numero de la Fact en el listbox1 If Hoja3.Columns("A").Find(What:=.List(row_LB, 0), LookAt:=xlWhole).Activate Then CeldaFact = ActiveCell.Text If CeldaFact = .List(row_LB, 0) Then Cells(ActiveCell.Row, "A").EntireRow.Delete End If End If Sheets("Temporal").Activate ' Se busca por numero de la Fact en el listbox1 If Sheets("Temporal").Columns("A").Find(What:=.List(row_LB, 0), LookAt:=xlWhole).Activate Then CeldaFact = ActiveCell.Text If CeldaFact = .List(row_LB, 0) Then Cells(ActiveCell.Row, "A").EntireRow.Delete End If End If Hoja10.Activate ' Se busca por numero de la Fact en el listbox1 If Hoja10.Columns("A").Find(What:=.List(row_LB, 0), LookAt:=xlWhole).Activate Then CeldaFact = ActiveCell.Text If CeldaFact = .List(row_LB, 0) Then Cells(ActiveCell.Row, "A").EntireRow.Delete End If End If Hoja5.Activate ' Se busca por numero de la Fact en el listbox1 If Hoja5.Columns("A").Find(What:=.List(row_LB, 0), LookAt:=xlWhole).Activate Then CeldaFact = ActiveCell.Text If CeldaFact = .List(row_LB, 0) Then Cells(ActiveCell.Row, "A").EntireRow.Delete End If End If .RemoveItem row_LB .ListIndex = -1 End With 'With Sheets("Salidas") ' .Range("a2:n2").Offset(row_LB).Delete xlShiftUp 'End With ' 'With Sheets("Temporal") ' .Range("a2:n2").Offset(row_LB).Delete xlShiftUp 'End With ' 'With Sheets("Resguardo") ' .Range("a2:i2").Offset(row_LB).Delete xlShiftUp 'End With ' 'With Sheets("Stock") ' .Range("a2:n2").Offset(row_LB).Delete xlShiftUp 'End With ' Application.ScreenUpdating = True MsgBox "Selección eliminada" End Sub Hola Alfonso, pega estos codigos en el userform Busqueda_Resguardo. Recuerda que el numero de factura debe ser igual y única en todas las hojas. Saludos, César
  9. Hola Ibrahim, revisa en: Private Sub UserForm_Initialize() o Private Sub UserForm_Activate(), ahi debe haber un código que se ejecuta en el textbox4, para realizar la numeración como describes. O sube tu archivo de ejemplo.
  10. Hola José, al principio llenas el listbox con datos de la hoja inventario, luego llenas el listbox con la hoja temporal, el index del combobox cambia, y no puedes borrar datos de otra hoja con index que no le corresponde. Analiza bien tu programación. Saludos,
  11. Hola Ibrahim, si tu código esta algo así como Format(text, "0000") , cambio por Format(text, "###0")
  12. Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) CommandButton6.Visible = True End Sub Hola José, si lo colocas en el combobox al presionar doble click
  13. Me.cboFamilia.RowSource = Names("Familia").RefersTo Me.cmbVentas.RowSource = Names("yUOM").RefersTo Me.cmbInventario.RowSource = Names("yUOM").RefersTo Me.cmbCompras.RowSource = Names("yUOM").RefersTo Hola José, los combobox llenalos según el código adjunto
  14. Gracias estimado Abraham, voy hacer lo que indicas, de loguearme con internet explorer.
×
×
  • Create New...

Important Information

Privacy Policy