jalomiva

Funciona perfecto, muchas gracias Haplox.

Buenas noche, el proyecto que estoy realizando y me tiene desconcertado ya que he leído, probado y vuelta a leer, y no lo consigo es que al filtrar desde el comboBox este me llene los datos filtrados al listBox,tambien comentar que el formulario no se encuentra en la hoja activa, agradeceria la ayuda, adjunto archivo 

Nuevo Hoja de cálculo de Microsoft Excel.xlsm

Solucionado, podeis dar por cerrado

Enviar Email masivo desde excel con Body distintos

el problema que me sugiere es el siguiente. En fila F (Causa) a la hora de correr la macro esta siempre me da el resultado de la F2, ya que cada destinatario la causa es diferente, la macro va ligada con (asunto & Causa & con un mensaje de despedida).

Gracias por adelantado.   

EnviarEmail.xlsm

Antoni, perfecto y muchas gracias por la rapidez

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

Antoni, me quito el sombrero, lo que es casi imposible para mi, tu lo haces fácil muchas gracias.

se me olvidó adjuntar el archivo

Prueba_V1.rar

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

Buenas noches, lo he solucionado insertando el siguiente código (TextBox13.Text = Format(TextBox13.Text, "##.00") en el textbox del formulario donde relleno la base de datos.

https://drive.google.com/file/d/1hapSr7W5KUpfHwUaG_3RN4se7N_sJGGh/view?usp=sharing

Archivo compartido.

Buenas tardes, hola Antoni no he tenido ningún problema al subir archivo hasta ahora, el libro lo he reducido a una hoja y aun así me sale el siguiente mensaje, pido disculpas porque al no poder adjuntar el archivo es eso de que una imagen vale más que mil palabras.

y esta es con filtrado

Buenas tardes adjunto imagen del mismo, esta es al importar lo hace correcto

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

gracias a todos por el aporte, a FLEMING si me di cuenta de que no me sumaba correcto y entre todos me lo habeis solucionado.. otra vez mas gracias.... esto es un foro GRANDEEEEE

gracias sois unos crakk

lo subo en excel 2003

EJEMPLO.zip

Tengo una hoja en la que tengo que sumar varias cantidades y cada numero se encuentra en nuna celda distinta.. he buscado y no he encontrado nada adjunto archivo y gracias por adelantado....

EJEMPLO.zip

Gracias Logroastus es justo lo que necesitaba muchas gracias por tu ayuda y a German

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

Hola German gracias por responder...... necesito una formula valida que al escribir en la celda D3 este se desarrolle con el ejemplo del adjunto del archivo ya que he intentado con: COINCIDIR--DIASEM y no logro la formula...

mi jefe me a pedido que desarrolle un cuadro de servicio anual el problema me surge que los turnos empiezan con una letra seguido de un mumero y se repite algun turno en la semana...si fuese los turnos numericos (1 2 3 4 6 .....) no tengo ninguna duda...

adjunto fichero.........gracias y un saludo a todos los foreros...

CUADRO ANUAL.zip

toldeman..... gracias ...gracias...gracias...y mil veces gracias eres un crack todo OOOOKKKKKKKK

salu2222

Gracias Toldeman por tu tiempo........ te estoy super agradecido por tu ayuda salu2222...