Macro para seleccionar datos de tabla en base a condiciones
Publicado por Camila (2 intervenciones) el 06/03/2018 04:25:23
Hola a todos!! Quería pedir su ayuda/orientación ya que he estado algo estancada :( Estoy haciendo una macro que consta de un formulario, el cuál suma datos en forma de tabla. Hasta ahí, ningún problema.
Mi idea es que los datos de la tabla sean llevados a un word, con el fin de generar un informe automatizado. Hasta ahora, he logrado pasar algunos datos al word gracias a una hoja auxiliar oculta (Hoja2), pero para lo demás, dicha hoja no me sirve.
Quiero que en el documento destino, la macro arroje un listado de las operaciones que presentan algún error ("No Coincide" o "No", en este caso). Esto lo quiero reemplazar en [reemp_operaciones], generando también un total de todos los errores por operación, los cuales debieran aparecer en [reemp_erroresop]
Ejemplo: N° Operación - Total errores
1 - 4
No he podido programar bien dicha función en el botón "Generar Informe", el cuál debiera dar como resultado el word con todos los datos que quiero. Solo tengo hecho un listbox que no funciona del todo bien (va anexado por medio de botón al UserForm1 y tengo que apretarlo dos veces, ya que en la primera me arroja datos en blanco).
Anexo imágenes a continuación:
(La tabla que se genera en base al formulario, de la cuál quiero generar la macro)
(El UserForm1, con los botones de Ingresar (el cuál no ha tenido problemas metiendo datos en la tabla) y el otro botón que lleva a la listbox)
(Lo primero que aparece cuando pincho el botón que da a la listbox)
(Cuando ya se arregla, arroja bien los datos, pero no sé cómo traspasarlo a word)
(El botón de generar informe que lleva al Word final)
(El informe final)
Anexo el código del botón que genera la listbox:
Private Sub CommandButton2_Click()
Dim fallas As Boolean
Dim j As Integer
Dim k As Integer
Dim contador As Integer
Worksheets("Resultados del Arqueo").Select
Range("B7").Select
UserForm2.Show
UserForm2.lbxVistaReporte.ColumnCount = 3
Do While ActiveCell.Value <> ""
contador = 0
j = 1
Do While ActiveCell.Offset(0, j) <> ""
If ActiveCell.Offset(0, j) = "No" Or ActiveCell.Offset(0, j) = "No Coincide" Then
contador = contador + 1
j = j + 1
Else
j = j + 1
End If
Loop
If contador > 0 Then
Dim filasi As Integer
filasi = UserForm2.lbxVistaReporte.ListCount
UserForm2.lbxVistaReporte.AddItem ActiveCell
UserForm2.lbxVistaReporte.List(filasi, 1) = ActiveCell.Offset(0, 1)
UserForm2.lbxVistaReporte.List(filasi, 2) = contador
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Y el del traspaso de datos a word, donde tengo marcados como comentarios los lugares donde quiero que vayan los datos que me faltan:
Private Sub BtnInforme_Click()
Dim datos(0 To 1, 0 To 6) As String '(columna,fila)
patharch = ThisWorkbook.Path & "\Prototipo Arqueo FWD.dotx"
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0
datos(0, 0) = "[reemp_totaloperaciones]"
datos(1, 0) = Hoja2.Cells(3, 2)
datos(0, 1) = "[reemp_porcentajeerror]"
datos(1, 1) = Round(Hoja2.Cells(4, 2), 1)
datos(0, 2) = "[reemp_totaldatos]"
datos(1, 2) = Hoja2.Cells(5, 2)
datos(0, 3) = "[reemp_totalfirmas]"
datos(1, 3) = Hoja2.Cells(6, 2)
datos(0, 4) = "[reemp_totalboveda]"
datos(1, 4) = Hoja2.Cells(7, 2)
'datos(0, 5) = "[reemp_operaciones]"
'datos(1, 5)
'datos(0, 6) = "[reemp_erroresop]"
'datos(1, 6) =
For i = 0 To UBound(datos, 2)
textobuscar = datos(0, i)
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=textobuscar
While objWord.Selection.Find.found = True
objWord.Selection.Text = datos(1, i) 'texto a reemplazar
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=textobuscar
Wend
Next i
objWord.Activate
End Sub
Toda orientación, vídeo, documento o lo que sea que pueda ayudarme será enormemente agradecido.
Mi idea es que los datos de la tabla sean llevados a un word, con el fin de generar un informe automatizado. Hasta ahora, he logrado pasar algunos datos al word gracias a una hoja auxiliar oculta (Hoja2), pero para lo demás, dicha hoja no me sirve.
Quiero que en el documento destino, la macro arroje un listado de las operaciones que presentan algún error ("No Coincide" o "No", en este caso). Esto lo quiero reemplazar en [reemp_operaciones], generando también un total de todos los errores por operación, los cuales debieran aparecer en [reemp_erroresop]
Ejemplo: N° Operación - Total errores
1 - 4
No he podido programar bien dicha función en el botón "Generar Informe", el cuál debiera dar como resultado el word con todos los datos que quiero. Solo tengo hecho un listbox que no funciona del todo bien (va anexado por medio de botón al UserForm1 y tengo que apretarlo dos veces, ya que en la primera me arroja datos en blanco).
Anexo imágenes a continuación:
(La tabla que se genera en base al formulario, de la cuál quiero generar la macro)
(El UserForm1, con los botones de Ingresar (el cuál no ha tenido problemas metiendo datos en la tabla) y el otro botón que lleva a la listbox)
(Lo primero que aparece cuando pincho el botón que da a la listbox)
(Cuando ya se arregla, arroja bien los datos, pero no sé cómo traspasarlo a word)
(El botón de generar informe que lleva al Word final)
(El informe final)
Anexo el código del botón que genera la listbox:
Private Sub CommandButton2_Click()
Dim fallas As Boolean
Dim j As Integer
Dim k As Integer
Dim contador As Integer
Worksheets("Resultados del Arqueo").Select
Range("B7").Select
UserForm2.Show
UserForm2.lbxVistaReporte.ColumnCount = 3
Do While ActiveCell.Value <> ""
contador = 0
j = 1
Do While ActiveCell.Offset(0, j) <> ""
If ActiveCell.Offset(0, j) = "No" Or ActiveCell.Offset(0, j) = "No Coincide" Then
contador = contador + 1
j = j + 1
Else
j = j + 1
End If
Loop
If contador > 0 Then
Dim filasi As Integer
filasi = UserForm2.lbxVistaReporte.ListCount
UserForm2.lbxVistaReporte.AddItem ActiveCell
UserForm2.lbxVistaReporte.List(filasi, 1) = ActiveCell.Offset(0, 1)
UserForm2.lbxVistaReporte.List(filasi, 2) = contador
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Y el del traspaso de datos a word, donde tengo marcados como comentarios los lugares donde quiero que vayan los datos que me faltan:
Private Sub BtnInforme_Click()
Dim datos(0 To 1, 0 To 6) As String '(columna,fila)
patharch = ThisWorkbook.Path & "\Prototipo Arqueo FWD.dotx"
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0
datos(0, 0) = "[reemp_totaloperaciones]"
datos(1, 0) = Hoja2.Cells(3, 2)
datos(0, 1) = "[reemp_porcentajeerror]"
datos(1, 1) = Round(Hoja2.Cells(4, 2), 1)
datos(0, 2) = "[reemp_totaldatos]"
datos(1, 2) = Hoja2.Cells(5, 2)
datos(0, 3) = "[reemp_totalfirmas]"
datos(1, 3) = Hoja2.Cells(6, 2)
datos(0, 4) = "[reemp_totalboveda]"
datos(1, 4) = Hoja2.Cells(7, 2)
'datos(0, 5) = "[reemp_operaciones]"
'datos(1, 5)
'datos(0, 6) = "[reemp_erroresop]"
'datos(1, 6) =
For i = 0 To UBound(datos, 2)
textobuscar = datos(0, i)
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=textobuscar
While objWord.Selection.Find.found = True
objWord.Selection.Text = datos(1, i) 'texto a reemplazar
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=textobuscar
Wend
Next i
objWord.Activate
End Sub
Toda orientación, vídeo, documento o lo que sea que pueda ayudarme será enormemente agradecido.
- Prototipo.rar(62,8 KB)
Valora esta pregunta
0