Jump to content

jalomiva

Members
  • Posts

    67
  • Joined

  • Last visited

Posts posted by jalomiva

  1. Buenas tardes, tengo esta macro que encontré en SanGoogle y la adapté a mi proyecto el cual funciona al 100% lo unico que al imprimir en A4 este lo hace en vertical y necesitaria que esta lo haga en horizontal, gracias por adelantado si alguno de los maestros me adaptaria dicha macro.

     

    Private Sub CommandButton5_Click()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next

    'Elimina hoja y crea hoja dando el mismo nombre que la eliminada


    Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD").Delete
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.name = "DFSHJFDUYDAYRAIUY544TTTOMYDUTGD"
    Set A = Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD")

    MsgBox "Esta seguro de imprimir los datos"

    For i = 0 To LISTA.ListCount - 1
        A.Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 0)
        A.Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 2)
        A.Range("C" & Range("C" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 3)
        A.Range("D" & Range("D" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 4)
        A.Range("E" & Range("E" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 5)
        A.Range("F" & Range("F" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 6)
        A.Range("G" & Range("G" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 7)
        A.Range("H" & Range("H" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 11)
        A.Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 12)
        A.Range("J" & Range("J" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 14)
        
    Next


    A.Range("A1") = "PRUEBA DE IMPRESIÓN"

    With A.Range("A1:J1")
    .Merge
    .VerticalAlignment = xlCenter
    .HorizontalAlignment = xlCenter
    .RowHeight = 20
    .Font.Size = 16
    End With

    A.Range("A2") = "AAAAAAAA"        'escribimos el encabezado de la columna
    A.Range("B2") = "BBBBBBBB"
    A.Range("C2") = "CCCCCCCC"
    A.Range("D2") = "DDDDDDDD"
    A.Range("E2") = "EEEEEEEE"
    A.Range("F2") = "FFFFFFFF"
    A.Range("G2") = "GGGGGGGG"
    A.Range("H2") = "HHHHHHHH"
    A.Range("I2") = "IIIIIIIIIII"
    A.Range("J2") = "JJJJJJJJ"

    uf = A.Range("K" & Rows.Count).End(xlUp).Row
    A.Range("B2:K" & uf).NumberFormat = "#.#,0"
    A.Range("I2:I" & uf).NumberFormat = "dd/mm/yyyy"
    A.Range("A:K").Columns.AutoFit
    A.Range("A:A").ColumnWidth = 10
    Application.PrintCommunication = True
    With ActiveSheet.PageSetup
    .PrintArea = "$A$1:$J$" & uf + 4
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    End With
    Application.PrintCommunication = True
    ActiveSheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    A.Delete
    Sheets("Hoja10").Select
    MsgBox "El informe se imprimió con éxito", vbCritical, "AVISO"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    End Sub

  2. Hola a los foreros y maestros del foro, tengo un duda que seguro que me daréis solución, en un listBox tengo una columna llenas de códigos ( al mes me genera mas de 1000 codigos en total)  estos van del B01 al B25, con el siguiente macro solo me reporta uno, he probado  y no se como  hacerlo para que me reporte la información de los 25 codigos y me cuente los generados (ejemplo B01 =124 ,  B02=78,  B03=189 ..etc) mi nivel de macros es de un principiante. Gracias por adelantado

    Private Sub CommandButton2_Click()
    For i = 0 To ListBox1.ListCount - 1
    If ListBox1.List(i, 5) = "B01" Then

    Contador = Contador + 1
    End If
    Next i

    Label3 = "B01 = " & Contador
    End Sub

  3. Buenas tardes a los foreros y en especial a los maestros que tanto nos reportan con sus conocimientos a los iniciados, el problema que se me representa con el formulario es que al cargar los datos estos los importa correctamente es a la hora de usar el filtro tanto el Control como la Fecha, la fila de Objetivo% (es numérico) no me respeta los dos decimales sino que este los amplía hasta llegar a 8 decimales he buscado por el foro y no visto nada al respecto, os agradecería cómo solucionar dicho inconveniente Gracias por adelantado .......no puedo adjuntar el archivo me dice que es demasiado grande, adjunto macro por si sirve de algo.

    Private Sub CommandButton3_Click()
    Dim Columnas As Integer

    Columnas = Range("Tabla6").Columns.Count

    Private Sub btnSalir_Click()
    End
    End Sub

    Private Sub CommandButton3_Click()


    Dim Columnas As Integer

    Columnas = Range("Tabla6").Columns.Count

    With Me.ListBox1

        .ColumnCount = Columnas
        .ColumnWidths = "55pt;160pt;55pt;55pt;55pt;65pt;65pt;65pt;60pt;50pt;0pt;0pt"
        .ColumnHeads = True
        .RowSource = "Tabla6"

    End With

    End Sub


    Private Sub CommandButton4_Click()
    Dim fila As Long, i As Long
    fila = Hoja9.Range("B" & Rows.Count).End(xlUp).Row + 1

    For i = 0 To ListBox1.ListCount - 1
        
      Hoja9.Cells(fila, 2) = ListBox1.List(i, 0)
      Hoja9.Cells(fila, 3) = ListBox1.List(i, 1)
      Hoja9.Cells(fila, 5) = ListBox1.List(i, 2)
      Hoja9.Cells(fila, 6) = ListBox1.List(i, 3)
      Hoja9.Cells(fila, 7) = ListBox1.List(i, 4)
      Hoja9.Cells(fila, 😎 = ListBox1.List(i, 5)
      Hoja9.Cells(fila, 9) = ListBox1.List(i, 6)
      Hoja9.Cells(fila, 10) = ListBox1.List(i, 7)
      Hoja9.Cells(fila, 14) = ListBox1.List(i, 😎
      
      
      fila = fila + 1
     
    Next i
       
    End Sub


    Private Sub CommandButton5_Click()
    Dim fila As Long, i As Long

    fila = Hoja10.Range("b" & Rows.Count).End(xlUp).Row
    ListBox1.Clear
    For i = 2 To fila

        If CDate(Hoja10.Cells(i, 14)) >= CDate(f_inicial) And CDate(Hofa10.Cells(i, 14)) <= CDate(f_final) Then
        
         Me.ListBox1
         .AddItem
      .List(.ListCount - 1, 0) = Hoja10.Cells(i, 2)
      .List(.ListCount - 1, 2) = Hoja10.Cells(i, 0)
      .List(.ListCount - 1, 3) = Hoja10.Cells(i, 1)
      '.List(.ListCount - 1, 4) = Hoja10.Cells(i, 2)
      .List(.ListCount - 1, 5) = Hoja10.Cells(i, 2)
      .List(.ListCount - 1, 6) = Hoja10.Cells(i, 3)
      .List(.ListCount - 1, 7) = Hoja10.Cells(i, 4)
      .List(.ListCount - 1, 😎 = Hoja10.Cells(i, 5)
      .List(.ListCount - 1, 9) = Hoja10.Cells(i, 6)
      .List(.ListCount - 1, 10) = Hoja10.Cells(i, 7)
      .List(.ListCount - 1, 14) = Hoja10.Cells(i, 😎
            
           End With
        
        End If
        
      Next i

    End Sub


    Private Sub ListBox1_Click()

    End Sub


    Private Sub TextBox1_Change()
    'Declaramos variables
    Dim fin As Long, i As Long, n As Long
    Dim sCadena_seccion As String
    'Filtramos por sección
    With Sheets("BD_CONTROL")
    fin = Application.CountA(.Range("B:B"))
    If TextBox1 = "" Then
        Me.ListBox1.RowSource = ("B3:K") & Worksheets("BD_CONTROL").Range("B" & Rows.Count).End(xlUp).Row
        Exit Sub
    End If
    Me.TextBox2 = Clear
    'Me.TextBox3 = Clear
    Me.ListBox1.RowSource = Clear
    For i = 2 To fin
        sCadena_matricula = .Cells(i, 2).Value
        If UCase(sCadena_matricula) Like "*" & UCase(TextBox1.Value) & "*" Then
            Me.ListBox1.AddItem
        
            Me.ListBox1.List(n, 0) = .Cells(i, 2).Value
            Me.ListBox1.List(n, 1) = .Cells(i, 3).Value
            Me.ListBox1.List(n, 2) = .Cells(i, 4).Value
            Me.ListBox1.List(n, 3) = .Cells(i, 5).Value
            Me.ListBox1.List(n, 4) = .Cells(i, 6).Value
            Me.ListBox1.List(n, 5) = .Cells(i, 7).Value
            Me.ListBox1.List(n, 6) = .Cells(i, 8).Value
            Me.ListBox1.List(n, 7) = .Cells(i, 9).Value
            Me.ListBox1.List(n, 8 = .Cells(i, 10).Value  'objetivos% 
            Me.ListBox1.List(n, 9) = .Cells(i, 11).Value
            n = n + 1
           End If
    Next
    Me.ListBox1.ColumnWidths = "55pt;170pt;55pt;55pt;55pt;65pt;65pt;65pt;60pt;50pt"
    End With

    End Sub


    Private Sub TextBox2_Change()
    Dim fin As Long, i As Long, n As Long
    Dim sCadena_seccion As String, sCadena_fecha As String
    'Una vez filtrados los datos por matricula, filtramos por fecha
    With Sheets("BD_CONTROL")
    fin = Application.CountA(.Range("B:B"))
    If TextBox2 = "" Then
        Me.ListBox1.RowSource = ("B3:K") & Worksheets("BD_CONTROL").Range("B" & Rows.Count).End(xlUp).Row
        Exit Sub
    End If

    Me.ListBox1 = Clear
    Me.ListBox1.RowSource = Clear
    For i = 2 To fin
        sCadena_matricula = .Cells(i, 2).Value
        sCadena_fecha = .Cells(i, 11).Value
        If UCase(sCadena_matricula) Like "*" & UCase(TextBox1.Value) & "*" And _
        UCase(sCadena_fecha) Like "*" & UCase(TextBox2.Value) & "*" Then
         Me.ListBox1.AddItem
        
            Me.ListBox1.List(n, 0) = .Cells(i, 2).Value
            Me.ListBox1.List(n, 1) = .Cells(i, 3).Value
            Me.ListBox1.List(n, 2) = .Cells(i, 4).Value
            Me.ListBox1.List(n, 3) = .Cells(i, 5).Value
            Me.ListBox1.List(n, 4) = .Cells(i, 6).Value
            Me.ListBox1.List(n, 5) = .Cells(i, 7).Value
            Me.ListBox1.List(n, 6) = .Cells(i, 8).Value
            Me.ListBox1.List(n, 7) = .Cells(i, 9).Value
            Me.ListBox1.List(n, 8 = .Cells(i, 10).Value  'objetivos%  
            Me.ListBox1.List(n, 9) = .Cells(i, 11).Value
            n = n + 1
           End If
    Next
    Me.ListBox1.ColumnWidths = "55pt;170pt;55pt;55pt;55pt;65pt;65pt;65pt;60pt;50pt"
    End With
    End Sub

  4. seria que al poner en el dia 1/1/2011 en celda D3 el turno correspondiente .. en este caso al caer en sabado corresponde al dia de descando "D"..en D4 como cae en domingo este tambien seria descanso "D" y el lunes seria el turno M1, martes M1,miercoles M1,jueves M1 y el viernes M2 y asi como esta en el adjunto..como son 3 trabajadores uno empieza con turno M1 - el otro con M4 ye tercero con M5,pero con el desarrollo del adjunto .............un saludo

×
×
  • Create New...

Important Information

Privacy Policy