كود انشاء جدول فى الاكسل VBA


التعامل مع الجداول


كود انشاء جدول فى الاكسل VBA
Range("B1").CurrentRegion.Select
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = "Table1"


http://arexcel.com/up/do.php?img=236

اظهار كل البيانات التى بالجدول filter clear
ThisWorkbook.Sheets(2).ListObjects("Table1").AutoFilter.ShowAllData



تصفية البيانات بدلالة العمود 2
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=2, Criteria1:="Alex"



التأكد من وجود الخلية بداخل جدول
Sub IsActiveCellInTable()
'PURPOSE: Determine if the current selected cell is part of an Excel Table
Dim TestForTable As String

'Test To See If Cell Is Within A Table
On Error Resume Next
TestForTable = ActiveCell.ListObject.Name
On Error GoTo 0

'Determine Results of Test
If TestForTable <> "" Then
'ActiveCell is within a ListObject Table
MsgBox "Cell is part of the table named: " & TestForTable
Else
'ActiveCell is NOT within a ListObject Table
MsgBox "Cell is not part of any table"
End If
End Sub



تحديد النطاق الكود المستخدم
Entire TableActiveSheet.ListObjects("Table1").Range.Select
Table Header RowActiveSheet.ListObjects("Table1").HeaderRowRange.Select
Table DataActiveSheet.ListObjects("Table1").DataBodyRange.Select
Third ColumnActiveSheet.ListObjects("Table1").ListColumns(3).Range.Select
Third Column (Data Only)ActiveSheet.ListObjects("Table1").ListColumns(3).DataBodyRange.Select
Select Row 4 of Table DataActiveSheet.ListObjects("Table1").ListRows(4).Range.Select
Select 3rd HeadingActiveSheet.ListObjects("Table1").HeaderRowRange(3).Select
Select Data point in Row 3, Column 2ActiveSheet.ListObjects("Table1").DataBodyRange(3, 2).Select
SubtotalsActiveSheet.ListObjects("Table1").TotalsRowRange.Select



ادراجالكود المستخدم
ادراج عمود جديد رقم 4ActiveSheet.ListObjects("Table1").ListColumns.Add Position:=4
ادراج عمود فى اخر الجدولActiveSheet.ListObjects("Table1").ListColumns.Add
ادراج صف فوق الصف 5ActiveSheet.ListObjects("Table1").ListRows.Add (5)
ادراج صف فى اخر الجدولActiveSheet.ListObjects("Table1").ListRows.Add AlwaysInsert:= True
ادراج صف المجموعActiveSheet.ListObjects("Table1").ShowTotals = True



حذف اجزاء من الجدول
Sub RemovePartsOfTable()
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("Table1")
'Remove 3rd Column
tbl.ListColumns(3).Delete
'Remove 4th DataBody Row
tbl.ListRows(4).Delete
'Remove 3rd through 5th DataBody Rows
tbl.Range.Rows("3:5").Delete
'Remove Totals Row
tbl.TotalsRowRange.Delete
End Sub



حذف كل الصفوف من الجدول ما عدا الصف الاول
Sub ResetTable()
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("Table1")
'Delete all table rows except first row
With tbl.DataBodyRange
If .Rows.Count > 1 Then
.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
End If
End With
'Clear out data from first table row
tbl.DataBodyRange.Rows(1).ClearContents
End Sub



المرور بكل الصفوف
Sub LoopingThroughTable()
Dim tbl As ListObject
Dim x As Long
Set tbl = ActiveSheet.ListObjects("Table1")
'Loop Through Each Column in Table
For x = 1 To tbl.ListColumns.Count
tbl.ListColumns(x).Range.ColumnWidth = 8
Next x
'Loop Through Every Row in Table
For x = 1 To tbl.Range.Rows.Count
tbl.Range.Rows(x).RowHeight = 20
Next x
'Loop Through Each DataBody Row in Table
For x = 1 To tbl.ListRows.Count
tbl.ListRows(x).Range.RowHeight = 15
Next x
End Sub



ترتيب الجدول عن طريق العمود 1
Sub SortTableColumn()
'PUPOSE: Sort Table in Ascending/Descending Order
Dim tbl As ListObject
Dim SortOrder As Integer
'Choose Sort Order
SortOrder = xlAscending '(or xlDescending)
'Store Desired Excel Table to a variable
Set tbl = ActiveSheet.ListObjects("Table1")
'Clear Any Prior Sorting
tbl.Sort.SortFields.Clear
'Apply A Sort on Column 1 of Table
tbl.Sort.SortFields.Add2 _
Key:=tbl.ListColumns(1).Range, _
SortOn:=xlSortOnValues, _
Order:=SortOrder, _
DataOption:=xlSortNormal
'Sort Options (if you want to change from default)
tbl.Sort.Header = xlYes
tbl.Sort.MatchCase = False
tbl.Sort.Orientation = xlTopToBottom
tbl.Sort.SortMethod = xlPinYin
'Apply the Sort to the Table
tbl.Sort.Apply
End Sub