Macro tabla dinámica
buenas tardes me pregunto si me podrías ayudar con un código que tengo de una macro que realiza una tabla dinámica con unos datos que baja de un software, lo que pasa es que no se como hacer que la columna grupo me la coloque en el campo filtro de la tabla dinámica aquí esta el código gracias.
Sub TraerLotus()
'
' TraerLotus Macro
' Macro grabada el 15/05/2003 por Mauricio Aguilar Toro
'
'
Dim ss As Object
Dim db As Object
Dim vista As Object
Dim dc As Object
Dim doc As Object
Dim busq As String
Dim cont As Integer
Dim Celda As String
Dim Rango As String
'Dim ss As New NotesSession
'Dim db As NotesDatabase
'Dim doc As NotesDocument
'Dim vista As NotesView
'Dim dc As NotesDocumentCollection
Set ss = CreateObject("Notes.NotesSession")
'ss.Initialize ("lotus")
Set db = ss.GETDATABASE("", "munmedcopia2012.nsf")
Set vista = db.GetView("PorFExcel")
Sheets("DATOS").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
'busq = InputBox("Por favor entre la fecha del despacho", "Fecha Despacho", Date)
busq = InputBox("Por favor entre la fecha del despacho", "Fecha Despacho")
Set dc = vista.GetAllDocumentsByKey(busq)
If dc.Count = 0 Then
MsgBox "No se encontraron despacho en esa fecha"
Exit Sub
End If
cont = 1
Celda = "A" + CStr(cont)
Range(Celda).Select
ActiveCell.Value = "Item"
Celda = "B" + CStr(cont)
Range(Celda).Select
ActiveCell.Value = "Escuela"
Celda = "C" + CStr(cont)
Range(Celda).Select
ActiveCell.Value = "Cantidad"
Celda = "D" + CStr(cont)
Range(Celda).Select
ActiveCell.Value = "Servicio"
Celda = "E" + CStr(cont)
Range(Celda).Select
ActiveCell.Value = "Grupo"
cont = cont + 1
Set doc = dc.GetFirstDocument
While Not doc Is Nothing
Celda = "A" + CStr(cont)
Range(Celda).Select
ActiveCell.Value = doc.GetItemValue("ItemUn")
Celda = "B" + CStr(cont)
Range(Celda).Select
ActiveCell.Value = doc.GetItemValue("Escuela")
Celda = "C" + CStr(cont)
Range(Celda).Select
ActiveCell.Value = doc.GetItemValue("CantidadReal")
Celda = "D" + CStr(cont)
Range(Celda).Select
ActiveCell.Value = doc.GetItemValue("Servicio")
Set doc = dc.GetNextDocument(doc)
cont = cont + 1
Wend
Rango = "DATOS!R1C1:R" + CStr(cont - 1) + "C5"
Range("A1").Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
Rango).CreatePivotTable TableDestination:="", TableName:= _
"Tabla dinámica1"
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("Tabla dinámica1").AddFields RowFields:="Escuela", _
ColumnFields:="Item"
ActiveSheet.PivotTables("Tabla dinámica1").PivotFields("Cantidad").Orientation _
= xlDataField
Cells.Select
Rows("4:4").Select
Selection.RowHeight = 102.6
Rows("4:4").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.Select
Cells.EntireColumn.AutoFit
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub
1 Respuesta
Adjunto te envío un código de ejemplo donde sitúa diferentes campos en las áreas de una pivot table de ejemplo. Creo que ahí puedes ver que necesitas.
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Campo1")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Campo2")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Campo3")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet. PivotTables("PivotTable1"). AddDataField ActiveSheet.PivotTables( _
"PivotTable1"). PivotFields("2132"), "Sum of Campo4", xlSum
Es decir, la propiedad Orientation te dice donde colocas el campo y Position el orden. En tu caso para poner un campo de página debes indicar el valor xlPageField, como el primer ejemplo del código.
Esto está hecho con Excel 2007 y posterior.
