هذه مجموعة أكواد أعددنها للتغلب علي موضوع تحديث عدد كبير من الجداول المحورية فى نفس الملف و تغيير مصدر بياناتها الي مجال محدد ( اسم ) و عرض و تغيير خاصية التحديث عند فتح الملف لها
و عذرا ، فلن يستفيد منها الا من يستخدم الجداول المحورية بالفعل و بكفاءة و تمكن
و هنا يوجد شرح ملخص لأساسياتها
http://www.arabteam2000.com/vb/showthread....%CD%E6%D1%ED%C9
و مرفق المثال لأكواد
و هذه هي الاكواد
اولا ملخص للاكواد فى المثال
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