مجموعة أكواد للتعامل مع الجداول المحورية

[محمد طاهر عرفه]

فى مشاركة سابقة تم شرح الجداول المحورية من هنا

و هذا شرح للمبتدئين

اما هذه المشاركة فللمتقدمين فى استخدامها :

هذه مجموعة أكواد أعددنها للتغلب علي موضوع تحديث عدد كبير من الجداول المحورية فى نفس الملف و تغيير مصدر بياناتها الي مجال محدد ( اسم ) و عرض و تغيير خاصية التحديث عند فتح الملف لها

و عذرا ، فلن يستفيد منها الا من يستخدم الجداول المحورية بالفعل و بكفاءة

اولا ملخص للاكواد فى المثال

Macros in this Workbook:


list_Cashes

   Lists All Pivot Cashes

لسرد جميع مجموعات بيانات الجداول المحورية فى الملف


List_PivSources_PerSheet

   List Pivot Table Sources Per Table Per Sheet

للسرد لكل ورقة عمل علي حدة


Change_PivotCashes_RangeName

   Change the Range name used as source for all Pivot Tables

تغيير المجال المستخدم كمصدر بيانات 


refresh

   Refreshes all Pivot Cashes

تحديث كل الجداول المحورية بالكود


list_RefreshonopenValue

   Lists the Refresh on open Property Value for all Cashes

سرد قيمة خاصية التحديث عند الفرز


Do_RefreshonOpen

No_RefreshonOpen

  To Enable and Disable Autorefresh of Pivot Table on Open

للتحكم فى خاصية التحديث عند الفتح

ثانيا الاكواد نفسها

Sub list_Cashes()


'Open "c:\temp.txt" For Output As #1

 'Lineinput ,#1 "koko"

 '  Close #1

  Dim fs, S, A

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set A = fs.CreateTextFile("c:\" & "temp.txt", True)

   

    A.writeline "Pivots in File named : " & ActiveWorkbook.FullName & " : "

    A.writeline

    A.writeline "*********** Prepared By Mohamed Taher *****************"

    A.writeline



 For i = 1 To ActiveWorkbook.PivotCaches.Count

     'ActiveWorkbook.PivotCaches(i).Refresh

     'Debug.Print "source of pivot no. ";

     'Debug.Print i;

     'Debug.Print " : ";

     'Debug.Print ActiveWorkbook.PivotCaches(i).SourceData

 Dim tmpLine As String

  

  tmpLine = "Pivot Cash no. " & i & " : " & ActiveWorkbook.PivotCaches(i).SourceData

  A.writeline (tmpLine)

   

 Next i

    


    A.Close

    

    Dim x

    x = Shell("notepad.exe c:\temp.txt", 1)

    

    


End Sub

Sub list_RefreshonopenValue()


'Open "c:\temp.txt" For Output As #1

 'Lineinput ,#1 "koko"

 '  Close #1

  Dim fs, S, A

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set A = fs.CreateTextFile("c:\" & "temp.txt", True)

   

    A.writeline "Pivots in File named : " & ActiveWorkbook.FullName & " : "

    A.writeline

    A.writeline "*********** Prepared By Mohamed Taher *****************"

    A.writeline



 For i = 1 To ActiveWorkbook.PivotCaches.Count



Dim tmpLine As String

  

  tmpLine = "Pivot Cash no. " & i & " refresh on open status : " & ActiveWorkbook.PivotCaches(i).RefreshOnFileOpen

  A.writeline (tmpLine)

   

 Next i

    


    A.Close

    

    Dim x

    x = Shell("notepad.exe c:\temp.txt", 1)

    

    


End Sub

Sub refresh()


    For i = 1 To ActiveWorkbook.PivotCaches.Count

     ActiveWorkbook.PivotCaches(i).refresh

    Next i


End Sub


Sub List_PivSources_PerSheet()


 Dim fs, S, A

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set A = fs.CreateTextFile("c:\" & "temp.txt", True)

    A.writeline "Pivots per Sheet - in File named : " & ActiveWorkbook.FullName & " : "

    A.writeline

    A.writeline "*********** Prepared By Mohamed Taher *****************"

    A.writeline

    

For j = 1 To ActiveWorkbook.Worksheets.Count

    A.writeline

    A.writeline "Sheet named : " & Worksheets(j).Name

    A.writeline "----------"

  For k = 1 To Worksheets(j).PivotTables.Count

      Dim tmpLine As String

      tmpLine = "source of pivot no. " & j & " : " & Worksheets(j).PivotTables(k).SourceData

      A.writeline (tmpLine)

  Next k

Next j


    A.Close

    

    Dim x

    x = Shell("notepad.exe c:\temp.txt", 1)

    

    


'Worksheets("Sheet3").PivotTables(1) _

    .PivotFields("Year").Orientation = xlRowField

End Sub



Sub Do_RefreshonOpen()

'True if the PivotTable cache or query table is automatically updated each time the workbook is opened


'For Each pc In ActiveWorkbook.PivotCaches

'    pc.RefreshOnFileOpen = True

'Next


 For i = 1 To ActiveWorkbook.PivotCaches.Count

   ActiveWorkbook.PivotCaches(i).RefreshOnFileOpen = True

 Next i


End Sub


Sub No_RefreshonOpen()

'True if the PivotTable cache or query table is automatically updated each time the workbook is opened


'For Each pc In ActiveWorkbook.PivotCaches

'    pc.RefreshOnFileOpen = False

'Next


 For i = 1 To ActiveWorkbook.PivotCaches.Count

   ActiveWorkbook.PivotCaches(i).RefreshOnFileOpen = False

 Next i



End Sub


Sub Change_PivotCashes_RangeName()


 Dim fs, S, A

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set A = fs.CreateTextFile("c:\" & "temp.txt", True)

    A.writeline "Change Pivot Sources per Sheet - in File named : " & ActiveWorkbook.FullName & " : "

    A.writeline

    A.writeline "*********** Prepared By Mohamed Taher *****************"

    A.writeline

    

    

Dim x As String

x = InputBox("PLease enter the Pivot Source Range Name", "Range name selection for Pivots", "SalesVillas")


For j = 1 To ActiveWorkbook.Worksheets.Count

    A.writeline

    A.writeline "Sheet named : " & Worksheets(j).Name

    A.writeline "================"

For k = 1 To Worksheets(j).PivotTables.Count

On Error GoTo errsub


 Dim y As String

 y = Worksheets(j).PivotTables(k).SourceData

 A.writeline "Before : " & y


     Worksheets(j).PivotTables(k).SourceData = Trim(x)

 A.writeline "After : " & Trim(x)

        


Next k

Next j


    A.Close

    

    Dim z

    z = Shell("notepad.exe c:\temp.txt", 1)


        Exit Sub

errsub:

        MsgBox Str(Err.Number) + Err.Description + "Action is cancelled"

        'return original source

        Worksheets(j).PivotTables(k).SourceData = y

        Exit Sub


End Sub

PivotCodes.rar