• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

acılan kutu da sorgu yapma

Katılım
7 Nisan 2008
Mesajlar
37
Excel Vers. ve Dili
2000sb-2003sb-xp standart
çok acil yardım istiyorum.


Sheets("Sayfa1").Select
Range("A1:C1").Select bu bölge yerine acılan penceredeki deger kabul olacak
Range(Selection, Selection.End(xlDown)).Select
Range("A1:C3980").Select bu bölge yerine acılan penceredeki deger kabul olacak
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Sayfa1!R1C1:R3980C3").CreatePivotTable TableDestination:="", TableName:= _
"Özet Tablo 1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("Özet Tablo 1").PivotFields("SİGORTA ETTİREN")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("Özet Tablo 1").AddDataField ActiveSheet.PivotTables( _
"Özet Tablo 1").PivotFields("ÖDEME TUTARI"), "Toplam ÖDEME TUTARI", xlSum
With ActiveSheet.PivotTables("Özet Tablo 1").PivotFields("GRUP POLİÇENO")
.Orientation = xlRowField
.Position = 2
End With
Range("B13").Select
Application.CommandBars("PivotTable").Visible = False
ActiveWorkbook.ShowPivotTableFieldList = False
Cells.Select
Selection.Copy
Sheets("Sayfa3").Select
Sheets.Add
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.EntireColumn.AutoFit
Columns("A:C").Select
Application.CutCopyMode = False
Sheets("Sayfa1").Select
Range("A1:A1").Select

ActiveSheet.Shapes("Button 3").Select
Selection.Copy
Sheets("Sayfa4").Select
ActiveWindow.ScrollColumn = 2
Range("E241").Select
ActiveSheet.Buttons.Add(514.5, 65.25, 145.5, 27.75).Select
ActiveSheet.Paste
Range("F246").Select

ActiveSheet.Shapes("Button 1").Select
Selection.Delete
ActiveSheet.Shapes("Button 2").Select
Selection.ShapeRange.IncrementLeft 97.5
Selection.ShapeRange.IncrementTop -73.5
Range("A1").Select
End Sub
 

Ekli dosyalar

Selamlar,

Sanırım özet tablo alanını otomatik genişletmek istiyorsunuz. Bunun için aşağıdaki kodu kullanabilirsiniz.

Kod:
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
[COLOR=red][B]Range("A1").CurrentRegion[/B][/COLOR]).CreatePivotTable TableDestination:="", TableName:= _
"Özet Tablo 1", DefaultVersion:=xlPivotTableVersion10
 
Selamlar,

Sanırım özet tablo alanını otomatik genişletmek istiyorsunuz. Bunun için aşağıdaki kodu kullanabilirsiniz.

Kod:
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
[COLOR=red][B]Range("A1").CurrentRegion[/B][/COLOR]).CreatePivotTable TableDestination:="", TableName:= _
"Özet Tablo 1", DefaultVersion:=xlPivotTableVersion10

istediğim esas bu değildi ama buda işimi görür. ellerine sağlık
 
Geri
Üst