مكتبة NPOI
اضاءة على المكتبة
السلام عليكم و رحمة الله و بركاته
بسم الله نبدأ , و نصلي عل سيدنا محمد و على اّله و صحبه و من والاه.
--------------------------------------------------------------------------------
المكتبة صصمت للتعامل مع ملفات الاكسل و الورد تحديدا , ابتداءأ من نسخ 2003 و الاعلى منها
لذا فهي تدعم كلا النوعين القديم و الحديث (Xls , Xlsx)
تدعم التعامل مع ملفات Word الصيغ الحديثة Docx
مجانية بالكامل و مدعومة ضمن اطار عمل Net.
لها فريق دعم مستمر 24 ساعة (ليس مجاني).
تدعم العمل ابتداءً من الاصدارة Net2. وما بعدها.
صفحتها على GitHub عبر الرابط NPOI يمكك تحميل الملف المضغوط في الصفحة و هو يحتوي على امثلة كثيرة.
رابط الويكي في نفس الصفحة السابقة ًWiki يحتوي على بنية الاطار الخاص بها مع امثلة.
المكتبة لها قروب خاص على موقع Linkedin وفق الرابط Linkedin Group يجب تقديم طلب للمجموعة.
لها مجتمع كبير على الانترنت (تستخدم مع لغات برمجة اخرى مثل الجافا و البايثون و غيرها)
تدعم العمل على الويب بشكل كامل.
-------------------------------------------------------------------------------------------------------------
التعامل مع المكتبة سلس و بسيط , يحتاج منك وقفة مع اطار العمل الخاص بها للتعرف على كائناته.
ولانني لا اريد الاطالة في الشرح سنبدأ بالتعرف على اهم كائناتها و التعامل معه وفق الاحتياج الاشيع لنا
وهو كيفية الاستيراد و التصدير من و الى واجهة البرنامج لدينا.
كما هي العادة عليك تحميل المكتبة من NuGet Packages الخاص بالمشروع لديك
و البحث في الشاشة اللاحقة عن المكتبة و تثبتها لديك.
بعد ان تكون قد حملت المكتبة ستضاف مراجعها تلقائياً الى مراجع المشروع لديك.
في واجهة المشروع لديك ستحتاج الى استيراد المراجع كما يلي
PHP كود :
Imports System.IO
Imports NPOI.HSSF.UserModel
Imports NPOI.SS.UserModel
Imports NPOI.XSSF.UserModel
المديول HSSF : خاص بالتعامل مع الصيغ القديمة ذات اللاحقة (Xls).
المديول XSSF : خاص بالتعمل مع الصيغ الحديثة ذات اللاحقة (Xlsx).
للتعامل مع ملف الاكسل عليك بتعريف كائن من النوع IWorkbook
PHP كود :
Private ObjectIWorkBook As IWorkbook
و لتعريف النوع (قديم او حديث) يتكلف به كائن من النوع IFormulaEvaluator
PHP كود :
Dim ObjectIFormulaEvaluator As IFormulaEvaluator
ObjectIFormulaEvaluator = New HSSFFormulaEvaluator(ObjectIWorkBook)
عملية تعبئة الكائن IWorkbook بملف الاكسل تجري وفق الطريقة التقليدية كما يلي:
PHP كود :
Using ObjectFileStream As FileStream = New FileStream(FileName, FileMode.Open, FileAccess.ReadWrite)
حيث FileName تمثل مسار الملف.
تستطيع فتح الملف للقراءة Read او قراءة و كتابة ReadWrite.
اسناد الدفق الذي نحصل عليه الى الكائن
PHP كود :
ObjectIWorkBook = New HSSFWorkbook(ObjectFileStream)
كما ترى من خلال الكود قمنا باخبار الكائن ان الملف بلاحقة Xls.
او يمكننا من خلال تحسس لاحقة الملف ان نبني طريقة مرنة للتعامل مع كلا النوعين :
PHP كود :
Private FileExtensionString As String
'نريد ان نميز بين الصيغ القديمة و الحديثة لذا سنعود بلاحقة الملف
FileExtensionString = System.IO.Path.GetExtension(FileName)
'صناعة كائن بالاعتماد على التنسيق
If FileExtensionString.Equals(".xls") Then
ObjectIWorkBook = New HSSFWorkbook(ObjectFileStream)
ObjectIFormulaEvaluator = New HSSFFormulaEvaluator(ObjectIWorkBook)
Else
ObjectIWorkBook = New XSSFWorkbook(ObjectFileStream)
ObjectIFormulaEvaluator = New XSSFFormulaEvaluator(ObjectIWorkBook)
End If
الكائن IWorkbook يحتوي بداخله الاوراق داخل المصنف و يحملها ضمن الكائن ISheet
لذا يمكنك المرور على الاوراق و تحميها ضمن مصفوفة :
PHP كود :
For Each Sheet As ISheet In ObjectIWorkBook
Comobox1.Items.Add(Sheet.SheetName)
Next
يمكنك الحصول على كائن ورقة عبر الطريقة GetSheet التابعة للكائن IShhet.
PHP كود :
Dim ObjectISheet As ISheet = ObjectIWorkBook.GetSheet(SheetName)
للوصول الى الصفوف داخل الورقة هناك من يتكفل بها , الكائن Irow .
يمثل صف ضمن الورقة المحددة و الصف يكون في مكان محدد.
PHP كود :
Dim HRow As IRow = ObjectISheet.GetRow(2)
هنا حددنا الصف الثاني في الورقة.
كما ترى الامر مشابه للعمل مع الجداول و الصفوف في اطار Net. تماما , اذا لا تختلف مفهومية الكائنات عن بعضا في كل المكاتب فقط هي الاسماء الطويلة و المعقدة ما تجعلنا نشعر بالرهاب.
اما الخلايا فنصل لها بنفس الاسلوب عبر الكائن Icell وهو يمثل خلية في الصف المحدد و في الموقع المحدد.
PHP كود :
Dim ICellObject As ICell = HRow.GetCell(1)
هل ترى معي سهولة العمل معها.
وفق ما تقدم من الاكواد السابقة و بعد بناء تصور بسيط و فهم الالية انت الان بت قادرا على جلب كل معلومات الملف.
و تستطيع ان تعبئ بيانات كل ورقة في جدول او مصفوفة تناسب احتياجاتك.
ربطاً مع ما سبق ولانني قررت كتابة المقال بالتزامن مع طلب احد الاخوة طريقة دعم لقراءة الملفات القديمة Xls , ولان المكتبة ClosedXml لم تلب الحاجة المطلوبة .
ققرت ان ان اشرح شيئاً بسيطأ عنها و نطبق مثال الاخ سفيان وفق مكتبتنا المشروحة هنا.
رابط السؤال هنا تعديل كود استيراد ملف اكسل
-عملية التصدير ستكون مشمولة ضمن المثال.
-التعامل مع الرجستري مشمولة ايضاً.
الخطوات المطلوبة في المثال.
-فتح ملف الاكسل و جلب الاوراق منه الى داخل البرنامج.
-إنشاء جدول لكل ورقة و تعبئة الجدول ببيانات الورقة.
-عرض بيانات كل جدول في DataGridView وفق الورقة المحددة.
-ترحيل البيانات من الجدول المحدد الى الورقة المحددة في ملف الاكسل.
-تعبئة صفوف بالاعتماد على مقارنات (حساب المعدل و التقيم و ترحيله).
-الاشارة الى مزايا اضافية يمكن التحكم بها داخل الورقة ان احتجنا لذلك.
________________________________
مما سبق نحن بحاجة الى حامل لملف الاكسل و بعدها نحن بحاجة الى تحديد نوعه و من ثم نحتاج الى المرور على الاوراق و تحميلها
ضمن ComboBox .
سنحتاج الى قاعدة بيانات مؤقته DataSet تحتوي الجداول التي سننشئها.
الجداول التي سننشئها , ستكون اعمدتها هي صف الاعمدة في الورقة.
بعد ذلك سنعبئ كل جدول من الورقة المحددة و ذلك بالمرور على صفوف الورقة و خلاياها و اضافة صف في الجدول.
بعد ذلك سنعرض بيانات الجدول المحدد في DataGridView.
لانشاء جدول للورقة المحددة نحن بحاجة لان نحدد صف الاعمدة في الورقة , ولان الورقة لا تحتوي على جدول حقيقي بداخلها , بل هي مجرد ورقة تم الكتابة في خلاياها بشكل مباشر و تنسيقها بشكل جدولي فعليه نحن بحاجة الى تحديد صف الاعمدة اثناء تشغيل البرنامج لذا نضع اداة NumericUpDown يستطيع المستخدم ان يحدد منها مكان صف الاعمدة.
نحتاج ان نجلب الورقة اولاً و نجلب صف الاعمدة في المكان المحدد و نمر على الخلايا في الصف و التي هي بدورها الاعمدة و من بعدها ننشئ جدول تكون اعمدته هذه الخلايا.
ساعمل كلاس منفصل يحتوي على الدوال المطلوبة سميته (Cls_NPOI_Walker)
نستورد فيه المراجع المطلوبة.
ونعرف متغيرين على مستوى الكلاس
PHP كود :
Private FileExtensionString As String
Private ObjectIWorkBook As IWorkbook
واحد لحامل ملف الاكسل , و الثاني يحمل لاحقة الملف
وكذلك سيكون لدينا خاصية نحدد عن طريقها صف البداية (صف الاعمدة) يستطيع المبرمج ان يحددها بالكود.
PHP كود :
Private _startPostion As Integer = 7
''' <summary>
''' You Can Set Row Postion of Table Headers Here , Default Value is 7
''' </summary>
''' <returns></returns>
Public Property StartPostion() As Integer
Get
Return _startPostion
End Get
Set(ByVal value As Integer)
_startPostion = value
End Set
End Property
القيمة الافتراضية لصف الاعمدة لدي ستكون 7 و ذلك بالاعتماد على الاوراق الموجودة لدي لذا يمكنك تغيرها بالكود كما تشاء.
الدالة المسؤولة عن القراءة كالتالي
PHP كود :
Public Sub ReadExcel(FileName As String, Cmb As ComboBox, DS As DataSet)
DS.Tables.Clear()
Cmb.Items.Clear()
Using ObjectFileStream As FileStream = New FileStream(FileName, FileMode.Open, FileAccess.ReadWrite)
'نريد ان نميز بين الصيغ القديمة و الحديثة لذا سنعود بلاحقة الملف
FileExtensionString = System.IO.Path.GetExtension(FileName)
Dim ObjectIFormulaEvaluator As IFormulaEvaluator
'صناعة كائن بالاعتماد على التنسيق
If FileExtensionString.Equals(".xls") Then
ObjectIWorkBook = New HSSFWorkbook(ObjectFileStream)
ObjectIFormulaEvaluator = New HSSFFormulaEvaluator(ObjectIWorkBook)
Else
ObjectIWorkBook = New XSSFWorkbook(ObjectFileStream)
ObjectIFormulaEvaluator = New XSSFFormulaEvaluator(ObjectIWorkBook)
End If
For Each Sheet As ISheet In ObjectIWorkBook
Cmb.Items.Add(Sheet.SheetName)
Next
Cmb.SelectedIndex = 0
End Using
End Sub
هذه الدالة ستكون تجميعية اذا ستحتوي بداخلها دوال اخرى.
ـــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ
للحصول على الاعمدة داخل الورقة اذاً نحن بحاجة للوصول الى الورقة المحددة و الصف المطلوب و المرور على خلاياه .
PHP كود :
'الحصول على الاعمدة من الورقة المحددة و الصف المحدد
Public Function GetRowHeader(ObjectIWorkBook As IWorkbook, SheetName As String) As List(Of DataColumn)
Dim ObjectISheet As ISheet = ObjectIWorkBook.GetSheet(SheetName)
Dim ObjectIFormulaEvaluator
If FileExtensionString.Equals(".xls") Then
ObjectIFormulaEvaluator = New HSSFFormulaEvaluator(ObjectIWorkBook)
Else
ObjectIFormulaEvaluator = New XSSFFormulaEvaluator(ObjectIWorkBook)
End If
Dim HRow As IRow = ObjectISheet.GetRow(_startPostion)
If Not IsNothing(HRow) Then
Dim ColumnsHeds As New List(Of DataColumn)
Dim LastColumnInThisRow As Integer = HRow.LastCellNum - 1
Dim CellContentString As String = ""
For Columnn As Integer = 0 To LastColumnInThisRow
Dim ICellObject As ICell = HRow.GetCell(Columnn)
CellContentString = GetFormattedCellValue(ICellObject, ObjectIFormulaEvaluator)
If Columnn = 4 Or Columnn = 5 Or Columnn = 6 Then
ColumnsHeds.Add(New DataColumn With {.ColumnName = CellContentString, .DataType = GetType(Double)})
Else
ColumnsHeds.Add(New DataColumn With {.ColumnName = CellContentString, .DataType = GetType(String)})
End If
LastColumnInThisRow += 1
Next
Return ColumnsHeds
Else
Return Nothing
End If
End Function
بالنسبة لهذه الدالة فيها بعض التخصيص بما يتناسب مع ملف الحاج سفيان نناقشها كما يلي:
الكود التالي مخصص
PHP كود :
If Columnn = 4 Or Columnn = 5 Or Columnn = 6 Then
ColumnsHeds.Add(New DataColumn With {.ColumnName = CellContentString, .DataType = GetType(Double)})
Else
ColumnsHeds.Add(New DataColumn With {.ColumnName = CellContentString, .DataType = GetType(String)})
End If
نظراً لان الاعمدة 4 ,5,6 تحتوي على نظام ارقام و هي غير منسقة في الملف الاصلي على انها خانات ارقام , اجبرت على الالتفاف عليها لانشئ اعمدة مخصصة ضمن الجدول.
واذا سالتني لماذا : ساقول لك بان ترحيل الصفوف ذات الطبيعة الرقمية الى خانات في الاكسل تحتوي ارقام يغنيك عن تحذيرات الاكسل بان ما قمت بترحيله الى هذه الخلايا هي نصوص و بالتالي سينتج عن ذلك تشويه في التنسيقات داخل الخلايا.
ولان الملف وزاري بالنسبة له و تعتمد حقول فيه على حسابات , لذا وجب الترحيل بمعطيات رقمة.
الدالة GetFormattedCellValue داخل الكود السابق هي دالة تعتمد على تنسيق الخلية داخل الصف , فلو كانت الخلايا لديك تحمل تنسيقات محددة مثل (خلية خاصة بالتاريخ ,او الارقام .. او غيرها ) يتم معالجتها في هذه الدالة, ملف الاخ سفيان لا يحتوي على ذلك كل تسيقات الخلايا لديه عام, الدالة تعود بمحتوى الخلية.
بنية الدالة
PHP كود :
'تحصيل محتوى الخلية
Private Function GetFormattedCellValue(cell As ICell, Optional ObjectIFormulaEvaluator As IFormulaEvaluator = Nothing) As String
If cell IsNot Nothing Then
Select Case cell.CellType
Case CellType.String
Return cell.StringCellValue
Case CellType.Numeric
If DateUtil.IsCellDateFormatted(cell) Then
Dim datee As DateTime = cell.DateCellValue
Dim style As ICellStyle = cell.CellStyle
Dim format As String = style.GetDataFormatString().Replace("m"c, "M"c)
Return datee.ToString(format)
Else
Return cell.NumericCellValue.ToString()
End If
Case CellType.Boolean
Return If(cell.BooleanCellValue, "TRUE", "FALSE")
Case CellType.Formula
If ObjectIFormulaEvaluator IsNot Nothing Then
Return GetFormattedCellValue(ObjectIFormulaEvaluator.EvaluateInCell(cell))
Else
Return cell.CellFormula
End If
Case CellType.[Error]
Return FormulaError.ForInt(cell.ErrorCellValue).String
End Select
End If
Return String.Empty
End Function
ـــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ
بعد ذلك وبالاعتماد على صف الاعمدة العائد من الدالة السابقة يمكننا انشاء جدول:
PHP كود :
'دالة انشاء جدول من مجموعة الاعمدة المحددة
Private Function CreateTable(tblName As String, ColumnList As List(Of DataColumn)) As DataTable
If Not IsNothing(ColumnList) Then
Dim Dt As New DataTable With {.TableName = tblName}
Dt.Columns.AddRange(ColumnList.ToArray)
Return Dt
Else
Return Nothing
End If
End Function
الدالة تعود بكائن جدول اسمه على اسم الورقة , اعمدته اسمائها نفس محتوى الخلايا في صف الاعمدة.
ـــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ
بعد ذلك يمكننا تصميم دالة لتعبئة الجدول بالبيانات و ذلك بالمرور على صفوف الورقة:
PHP كود :
'تعبئة بيانات الورقة في الجدول
Public Sub GetData(ObjectIWorkBook As IWorkbook, SheetName As String, Dt As DataTable)
Dim ObjectISheet As ISheet = ObjectIWorkBook.GetSheet(SheetName)
Dim ObjectIFormulaEvaluator As IFormulaEvaluator '= New HSSFFormulaEvaluator(ObjectIWorkBook)
If FileExtensionString.Equals(".xls") Then
ObjectIFormulaEvaluator = New HSSFFormulaEvaluator(ObjectIWorkBook)
Else
ObjectIFormulaEvaluator = New XSSFFormulaEvaluator(ObjectIWorkBook)
End If
Dim DataRowPos As Integer = _startPostion + 1
For RowData As Integer = DataRowPos To ObjectISheet.LastRowNum
Dim HRow As IRow = ObjectISheet.GetRow(DataRowPos)
If Not IsNothing(HRow) AndAlso HRow.Cells.Count > 0 Then
Dt.Rows.Add()
Dim LastColumnInThisRow As Integer = HRow.LastCellNum - 1
Dim CellContentString As String = ""
For Columnn As Integer = 0 To LastColumnInThisRow
Dim ICellObject As ICell = HRow.GetCell(Columnn)
CellContentString = GetFormattedCellValue(ICellObject, ObjectIFormulaEvaluator)
If CellContentString = String.Empty Then
Dt.Rows(Dt.Rows.Count - 1)(Columnn) = DBNull.Value
Else
Dt.Rows(Dt.Rows.Count - 1)(Columnn) = CellContentString
End If
LastColumnInThisRow += 1
Next
End If
DataRowPos += 1
Next
End Sub
ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ
بعد استكمالنا لكل الاجزاء الخاصة بالقراءة و انشاء الجدول و تعبئتها , سنشملها في دالة القراءة لتصبح دالة القراءة كالتالي:
PHP كود :
Public Sub ReadExcel(FileName As String, Cmb As ComboBox, DS As DataSet)
Dim CellContentString As String = Nothing
DS.Tables.Clear()
Cmb.Items.Clear()
Using ObjectFileStream As FileStream = New FileStream(FileName, FileMode.Open, FileAccess.ReadWrite)
'نريد ان نميز بين الصيغ القديمة و الحديثة لذا سنعود بلاحقة الملف
FileExtensionString = System.IO.Path.GetExtension(FileName)
Dim ObjectIFormulaEvaluator As IFormulaEvaluator
'صناعة كائن بالاعتماد على التنسيق
If FileExtensionString.Equals(".xls") Then
ObjectIWorkBook = New HSSFWorkbook(ObjectFileStream)
ObjectIFormulaEvaluator = New HSSFFormulaEvaluator(ObjectIWorkBook)
Else
ObjectIWorkBook = New XSSFWorkbook(ObjectFileStream)
ObjectIFormulaEvaluator = New XSSFFormulaEvaluator(ObjectIWorkBook)
End If
Dim ColumnList As New List(Of DataColumn)
Dim DT As New DataTable
For Each Sheet As ISheet In ObjectIWorkBook
Cmb.Items.Add(Sheet.SheetName)
'جلب الاعمدة من الورقة المحددة
ColumnList = GetRowHeader(ObjectIWorkBook, Sheet.SheetName)
'بناء جدول بالاعتماد على الاعمدة
DT = CreateTable(Sheet.SheetName, ColumnList)
'اضافة الجدول
If Not IsNothing(DT) Then
If Not DS.Tables.Contains(Sheet.SheetName) Then
DS.Tables.Add(DT)
'ملئ الجدول بالبيانات
GetData(ObjectIWorkBook, Sheet.SheetName, DT)
End If
End If
Next
Cmb.SelectedIndex = 0
End Using
End Sub
الى هنا نكون انتهينا من قراءة الملف و تحميل الاوراق و بناء الجداول و تعبئتها .
قبل ان ادخل في جزئية التصدير الى الاكسل وددت ان القي الضوء على التعامل مع الرجستري (مسجل النظام)
لان مثالنا يعتمد على ادخالات مسبقة فكان من الواجب ايجاد طريقة لتخزين هذه الثوابت (في قاعدة بيانات او اي مكان تخزيني)
ولانها بيانات قليلة ومن صف واحد , فضلت تخزينها في مسجل النظام في مجلد خاص بالبرنامج .
ولكي لا اطيل عليكم كثيراً .
صنعت كلاس خاص بالادخالات , وجعلته ينطلق مع بدأ تشغيل البرنامج و يقوم بالادخالات اللازمة اذا لم تكن موجودة.
هذا الكلاس مرن جداً و هو يناسب الكثير من البرامج التي تحتاج ان تكون لديها حقول معرفه مسبقاً (نصوص الاتصال,المستخدمين,الصلاحيات..وغيرها).
في مثالنا نحن نحتاج الى سبع حقول نخزنها و نعدل في قيمها كما نريد لاحقاً
ساضع بنية الكلاس هنا و هو مشروح بالشكل المفصل جداً
يمكنك استخدامه في الكثير من الامور التي تحتاج الى تخزين حقول في الرجستري
PHP كود :
Imports System.IO
Imports System.Management
Imports System.Text
Imports Microsoft.Win32
Friend Module Utility
''' <summary>
''' Get Thee Application Name As string
''' نص يستخدم لتحصيل اسم البرنامج لا ستخدامه في عمليات تخزين المفاتيح في الرجستري
''' </summary>
Public ApplicationName As String = System.Reflection.Assembly.GetExecutingAssembly().GetName().Name
#Region "Registry Keys"
'مسار الجذر الخاص بتخزين مفاتيح البرنامج في الرجستري
Private ReadOnly MainKeyPath As String = "Software\AboLayla\" & ApplicationName
'المفتاح الرئيسي للبرنامج في الرجستري يتم معالجته في الكود في الاسفل
Dim UserMainKey As RegistryKey
''' <summary>
''' المعدل من 00-07
''' </summary>
''' <returns></returns>
Public Property Avg1() As String
Get
Return UserMainKey.GetValue("Avg1", String.Empty)
End Get
Set(ByVal value As String)
UserMainKey.SetValue("Avg1", value, RegistryValueKind.String)
End Set
End Property
''' <summary>
''' المعدل من 07-10
''' </summary>
''' <returns></returns>
Public Property Avg2() As String
Get
Return UserMainKey.GetValue("Avg2", String.Empty)
End Get
Set(ByVal value As String)
UserMainKey.SetValue("Avg2", value, RegistryValueKind.String)
End Set
End Property
''' <summary>
''' المعدل من 10-12
''' </summary>
''' <returns></returns>
Public Property Avg3() As String
Get
Return UserMainKey.GetValue("Avg3", String.Empty)
End Get
Set(ByVal value As String)
UserMainKey.SetValue("Avg3", value, RegistryValueKind.String)
End Set
End Property
''' <summary>
''' المعدل من 12-14
''' </summary>
''' <returns></returns>
Public Property Avg4() As String
Get
Return UserMainKey.GetValue("Avg4", String.Empty)
End Get
Set(ByVal value As String)
UserMainKey.SetValue("Avg4", value, RegistryValueKind.String)
End Set
End Property
''' <summary>
''' المعدل من 14-16
''' </summary>
''' <returns></returns>
Public Property Avg5() As String
Get
Return UserMainKey.GetValue("Avg5", String.Empty)
End Get
Set(ByVal value As String)
UserMainKey.SetValue("Avg5", value, RegistryValueKind.String)
End Set
End Property
''' <summary>
''' المعدل من 16-18
''' </summary>
''' <returns></returns>
Public Property Avg6() As String
Get
Return UserMainKey.GetValue("Avg6", String.Empty)
End Get
Set(ByVal value As String)
UserMainKey.SetValue("Avg6", value, RegistryValueKind.String)
End Set
End Property
''' <summary>
''' المعدل من 18-20
''' </summary>
''' <returns></returns>
Public Property Avg7() As String
Get
Return UserMainKey.GetValue("Avg7", String.Empty)
End Get
Set(ByVal value As String)
UserMainKey.SetValue("Avg7", value, RegistryValueKind.String)
End Set
End Property
''' <summary>
''' فحص توفر اي مفتاح داخل الرجستري
''' </summary>
''' <param name="baseKey"></param>
''' <param name="subKeyName"></param>
''' <returns></returns>
Private Function KeyExists(ByVal baseKey As RegistryKey, ByVal subKeyName As String) As Boolean
Dim KeyStatus As RegistryKey = baseKey.OpenSubKey(subKeyName, True)
Return (Not (KeyStatus) Is Nothing)
End Function
''' <summary>
''' دالة تعيد مسار الجذر الخاص بتخزين مفاتيح البرنامج في الرجستري
''' </summary>
''' <returns></returns>
Public Function ApplicationKeyName() As String
If KeyExists(Registry.CurrentUser, MainKeyPath) Then
Return (Registry.CurrentUser.OpenSubKey(MainKeyPath).Name)
End If
Return "لم يتم تسجيل جذر للبرنامج في مسجل النظام بعد"
End Function
''' <summary>
''' دالة تعيد المفتاح المحدد الرجستري
''' </summary>
''' <returns></returns>
Public Function AppKey(Key As String) As RegistryKey
If KeyExists(Registry.CurrentUser, Key) Then
Return (Registry.CurrentUser.OpenSubKey(Key, True))
End If
Return Nothing
End Function
''' <summary>
''' انشاء جذر البرنامج في حال لم يكن موجود يتم انشائه
''' يتم التاكد من الحقول و في حال عدم توفرها يتم انشائها
''' </summary>
Public Sub GenerateRegistryKyes()
'انشاء الجذر الرئيسي في حال لم يكن موجود
If KeyExists(Registry.CurrentUser, MainKeyPath) = False Then
Using registryKey As RegistryKey = Registry.CurrentUser.CreateSubKey(MainKeyPath)
CreateKeyFileds(registryKey)
End Using
Else
CreateKeyFileds(Registry.CurrentUser.OpenSubKey(MainKeyPath, True))
End If
'
UserMainKey = AppKey(MainKeyPath)
End Sub
''' <summary>
''' انشاء حقل داخل مفتاح رجستري
''' يتم التاكد من توفر الحقل قبل انشائه
''' </summary>
''' <param name="RootKey">المفتاح</param>
''' <param name="Name">اسم الحقل</param>
''' <param name="Vlaue">القيمة</param>
''' <param name="TypeName">Value Kind As RegistryValueKind</param>
Private Sub CreateValueName(RootKey As RegistryKey, Name As String, Vlaue As String, TypeName As RegistryValueKind)
If Not RootKey.GetValueNames.Contains(Name) Then RootKey.SetValue(Name, Vlaue, TypeName)
End Sub
''' <summary>
''' من هتا يتم انشاء حقول داخل جذر البرنامج
''' يتم التأكد من وجود الحقل اولاً و في حال عدم وجوده يتم انشاءه
''' يمكنك اضافة اي حقل هنا و سيتكفل الاجراء بانشاءه
''' </summary>
''' <param name="BaseKey"></param>
Private Sub CreateKeyFileds(BaseKey As RegistryKey)
CreateValueName(BaseKey, "Avg1", "", RegistryValueKind.String)
CreateValueName(BaseKey, "Avg2", "", RegistryValueKind.String)
CreateValueName(BaseKey, "Avg3", "", RegistryValueKind.String)
CreateValueName(BaseKey, "Avg4", "", RegistryValueKind.String)
CreateValueName(BaseKey, "Avg5", "", RegistryValueKind.String)
CreateValueName(BaseKey, "Avg6", "", RegistryValueKind.String)
CreateValueName(BaseKey, "Avg7", "", RegistryValueKind.String)
End Sub
#End Region
End Module
الحمد لله عل كل حال (بعد الانتهاء من شرح كل شيئ و محاولة الرفع ضاع كل شي, ما اقسى ان تعيد الكتابة).
عمليات التصدير.
كما هي الحالة مع الاستيراد نتعامل مع كائن ونفتحه للكتابة و نرسل له محتويات الجدول الى الورقة المحددة التي توافق اسم الجدول
العملية سهلة و بسيطة فقط المرور على صفوف الجدول و الكتابة الى الخلايا الموافقة بدءً من الصف المحدد .
دالة التصدير :
PHP كود :
Public Sub DataTable_To_Excel(ByVal pDatos As DataTable, ByVal pFilePath As String, StartWrite As Integer)
If pDatos IsNot Nothing AndAlso pDatos.Rows.Count > 0 Then
Dim workbook As IWorkbook = Nothing
Dim worksheet As ISheet = Nothing
workbook = ObjectIWorkBook
Using File As FileStream = New FileStream(pFilePath, FileMode.Open, FileAccess.ReadWrite)
Dim Ext As String = System.IO.Path.GetExtension(pFilePath)
Select Case Ext.ToLower()
Case ".xls"
workbook = New HSSFWorkbook(File)
Case ".xlsx"
workbook = New XSSFWorkbook(File)
End Select
worksheet = workbook.GetSheet(pDatos.TableName)
For Each DTrow As DataRow In pDatos.Rows
Dim SheetRow As IRow = worksheet.GetRow(StartWrite)
If Not IsNothing(SheetRow) AndAlso SheetRow.Cells.Count > 0 Then
Dim Avg As String = CalcAvg(DTrow)
Dim iCol As Integer = 0
For Each column As DataColumn In pDatos.Columns
If column.Ordinal > 3 Then
If iCol = 7 Then
SheetRow.CreateCell(iCol).SetCellValue(Avg)
Dim Font = ObjectIWorkBook.CreateFont()
Font.FontHeightInPoints = 16
Font.FontName = "Arial"
SheetRow.Cells(iCol).CellStyle.SetFont(Font)
End If
Dim cell As ICell = SheetRow.Cells(iCol)
Dim cellValue As Object = DTrow(iCol)
If Not (cellValue.ToString) = Nothing Then
Select Case column.DataType.ToString()
Case "System.Double"
cell.SetCellValue(Convert.ToDouble(cellValue.ToString))
Case "System.String"
cell.SetCellValue(Convert.ToString(cellValue.ToString))
End Select
End If
End If
iCol += 1
Next
StartWrite += 1
End If
Next
workbook.Write(File)
File.Close()
End Using
End If
End Sub
الدالة بها تخصيص يوافق ملف الاخ سفيان,يحتاج ان يعدل فقط بعض الاعمدة لذا تم المرور على اعمدة محددة (الورقة محمية).
العمود 7 في الورقة يتم ملئه بالاعتماد على حقل اخر ,لذا تم ربطه بالدالة CalcAvg
كذلك هذا العمود له تنسق خط مختلف تم انشائه و تطبيقه على الخلية.
صورة من الملف
هذه الحقول التي يتم التعديل فيها فقط
الدالة CalcAvg تعتمد على حقول الرجستري التي تم انشائها في الكلاس Utilty .
بنية الدالة
PHP كود :
'حساب معدلات التقييم
Private Function CalcAvg(Row As DataRow) As String
If Row IsNot Nothing Then
Dim Avg As Double = Nothing
If Row(4).ToString = Nothing Or IsNothing(Row(5).ToString) Or IsNothing(Row(6).ToString) Then
Avg = 0
Return Avg
End If
Avg = Row(6)
Select Case Avg
Case 0 To 7
Row(7) = Avg1
Case 7 To 10
Row(7) = Avg2
Case 10 To 12
Row(7) = Avg3
Case 12 To 14
Row(7) = Avg4
Case 14 To 16
Row(7) = Avg5
Case 16 To 18
Row(7) = Avg6
Case 18 To 20
Row(7) = Avg7
End Select
Return Avg
End If
Return Nothing
End Function
بعض الاكواد الخاصة بتنسيق الخلايا
PHP كود :
Dim _doubleCellStyle As ICellStyle = workbook.CreateCellStyle()
_doubleCellStyle.DataFormat = workbook.CreateDataFormat().GetFormat("#,##0.###")
Dim _intCellStyle As ICellStyle = workbook.CreateCellStyle()
_intCellStyle.DataFormat = workbook.CreateDataFormat().GetFormat("#,##0")
Dim _boolCellStyle As ICellStyle = workbook.CreateCellStyle()
_boolCellStyle.DataFormat = workbook.CreateDataFormat().GetFormat("BOOLEAN")
Dim _dateCellStyle As ICellStyle = workbook.CreateCellStyle()
_dateCellStyle.DataFormat = workbook.CreateDataFormat().GetFormat("dd-MM-yyyy")
Dim _dateTimeCellStyle As ICellStyle = workbook.CreateCellStyle()
_dateTimeCellStyle.DataFormat = workbook.CreateDataFormat().GetFormat("dd-MM-yyyy HH:mm:ss")
كيفية تطبيق ما سبق:
المثال المرفق في رابط السؤال افتحه لديك واضف له كلاس جديد
الكلاس
PHP كود :
Imports System.Windows
Imports System.IO
Imports NPOI.HSSF.UserModel
Imports NPOI.SS.UserModel
Imports NPOI.XSSF.UserModel
Public Class Cls_NPOI_Walker
Private FileExtensionString As String
Private ObjectIWorkBook As IWorkbook
'صف البداية
Private _startPostion As Integer = 7
''' <summary>
''' You Can Set Row Postion of Table Headers Here , Default Value is 7
''' </summary>
''' <returns></returns>
Public Property StartPostion() As Integer
Get
Return _startPostion
End Get
Set(ByVal value As Integer)
_startPostion = value
End Set
End Property
Sub New(_ObjectIWorkBook As IWorkbook)
ObjectIWorkBook = _ObjectIWorkBook
End Sub
'هذه الدالة مجمعة من عدة اجزاء تقوم بمجملها بقراءة ملف الاكسل
'تقوم بالمرور على صفحات المستند و تنشئ جدول لكل صفحة و تعبئ بيانات الورقة ضمن الجدول
Public Sub ReadExcel(FileName As String, Cmb As ComboBox, DS As DataSet)
Dim CellContentString As String = Nothing
DS.Tables.Clear()
Cmb.Items.Clear()
Using ObjectFileStream As FileStream = New FileStream(FileName, FileMode.Open, FileAccess.ReadWrite)
'نريد ان نميز بين الصيغ القديمة و الحديثة لذا سنعود بلاحقة الملف
FileExtensionString = System.IO.Path.GetExtension(FileName)
Dim ObjectIFormulaEvaluator As IFormulaEvaluator
'صناعة كائن بالاعتماد على التنسيق
If FileExtensionString.Equals(".xls") Then
ObjectIWorkBook = New HSSFWorkbook(ObjectFileStream)
ObjectIFormulaEvaluator = New HSSFFormulaEvaluator(ObjectIWorkBook)
Else
ObjectIWorkBook = New XSSFWorkbook(ObjectFileStream)
ObjectIFormulaEvaluator = New XSSFFormulaEvaluator(ObjectIWorkBook)
End If
Dim ColumnList As New List(Of DataColumn)
Dim DT As New DataTable
For Each Sheet As ISheet In ObjectIWorkBook
Cmb.Items.Add(Sheet.SheetName)
'جلب الاعمدة من الورقة المحددة
ColumnList = GetRowHeader(ObjectIWorkBook, Sheet.SheetName)
'بناء جدول بالاعتماد على الاعمدة
DT = CreateTable(Sheet.SheetName, ColumnList)
'اضافة الجدول
If Not IsNothing(DT) Then
If Not DS.Tables.Contains(Sheet.SheetName) Then
DS.Tables.Add(DT)
'ملئ الجدول بالبيانات
GetData(ObjectIWorkBook, Sheet.SheetName, DT)
End If
End If
Next
Cmb.SelectedIndex = 0
End Using
End Sub
'تحصيل محتوى الخلية
Private Function GetFormattedCellValue(cell As ICell, Optional ObjectIFormulaEvaluator As IFormulaEvaluator = Nothing) As String
If cell IsNot Nothing Then
Select Case cell.CellType
Case CellType.String
Return cell.StringCellValue
Case CellType.Numeric
If DateUtil.IsCellDateFormatted(cell) Then
Dim datee As DateTime = cell.DateCellValue
Dim style As ICellStyle = cell.CellStyle
Dim format As String = style.GetDataFormatString().Replace("m"c, "M"c)
Return datee.ToString(format)
Else
Return cell.NumericCellValue.ToString()
End If
Case CellType.Boolean
Return If(cell.BooleanCellValue, "TRUE", "FALSE")
Case CellType.Formula
If ObjectIFormulaEvaluator IsNot Nothing Then
Return GetFormattedCellValue(ObjectIFormulaEvaluator.EvaluateInCell(cell))
Else
Return cell.CellFormula
End If
Case CellType.[Error]
Return FormulaError.ForInt(cell.ErrorCellValue).String
End Select
End If
Return String.Empty
End Function
'الحصول على الاعمدة من الورقة المحددة و الصف المحدد
Public Function GetRowHeader(ObjectIWorkBook As IWorkbook, SheetName As String) As List(Of DataColumn)
Dim ObjectISheet As ISheet = ObjectIWorkBook.GetSheet(SheetName)
Dim ObjectIFormulaEvaluator
If FileExtensionString.Equals(".xls") Then
ObjectIFormulaEvaluator = New HSSFFormulaEvaluator(ObjectIWorkBook)
Else
ObjectIFormulaEvaluator = New XSSFFormulaEvaluator(ObjectIWorkBook)
End If
Dim HRow As IRow = ObjectISheet.GetRow(_startPostion)
If Not IsNothing(HRow) Then
Dim ColumnsHeds As New List(Of DataColumn)
Dim LastColumnInThisRow As Integer = HRow.LastCellNum - 1
Dim CellContentString As String = ""
For Columnn As Integer = 0 To LastColumnInThisRow
Dim ICellObject As ICell = HRow.GetCell(Columnn)
CellContentString = GetFormattedCellValue(ICellObject, ObjectIFormulaEvaluator)
If Columnn = 4 Or Columnn = 5 Or Columnn = 6 Then
ColumnsHeds.Add(New DataColumn With {.ColumnName = CellContentString, .DataType = GetType(Double)})
Else
ColumnsHeds.Add(New DataColumn With {.ColumnName = CellContentString, .DataType = GetType(String)})
End If
LastColumnInThisRow += 1
Next
Return ColumnsHeds
Else
Return Nothing
End If
End Function
'دالة انشاء جدول من مجموعة الاعمدة المحددة
Private Function CreateTable(tblName As String, ColumnList As List(Of DataColumn)) As DataTable
If Not IsNothing(ColumnList) Then
Dim Dt As New DataTable With {.TableName = tblName}
Dt.Columns.AddRange(ColumnList.ToArray)
Return Dt
Else
Return Nothing
End If
End Function
'تعبئة بيانات الورقة في الجدول
Public Sub GetData(ObjectIWorkBook As IWorkbook, SheetName As String, Dt As DataTable)
Dim ObjectISheet As ISheet = ObjectIWorkBook.GetSheet(SheetName)
Dim ObjectIFormulaEvaluator As IFormulaEvaluator '= New HSSFFormulaEvaluator(ObjectIWorkBook)
If FileExtensionString.Equals(".xls") Then
ObjectIFormulaEvaluator = New HSSFFormulaEvaluator(ObjectIWorkBook)
Else
ObjectIFormulaEvaluator = New XSSFFormulaEvaluator(ObjectIWorkBook)
End If
Dim DataRowPos As Integer = _startPostion + 1
For RowData As Integer = DataRowPos To ObjectISheet.LastRowNum
Dim HRow As IRow = ObjectISheet.GetRow(DataRowPos)
If Not IsNothing(HRow) AndAlso HRow.Cells.Count > 0 Then
Dt.Rows.Add()
Dim LastColumnInThisRow As Integer = HRow.LastCellNum - 1
Dim CellContentString As String = ""
For Columnn As Integer = 0 To LastColumnInThisRow
Dim ICellObject As ICell = HRow.GetCell(Columnn)
CellContentString = GetFormattedCellValue(ICellObject, ObjectIFormulaEvaluator)
If CellContentString = String.Empty Then
Dt.Rows(Dt.Rows.Count - 1)(Columnn) = DBNull.Value
Else
Dt.Rows(Dt.Rows.Count - 1)(Columnn) = CellContentString
End If
LastColumnInThisRow += 1
Next
End If
DataRowPos += 1
Next
End Sub
Public Sub DataTable_To_Excel(ByVal pDatos As DataTable, ByVal pFilePath As String, StartWrite As Integer)
If pDatos IsNot Nothing AndAlso pDatos.Rows.Count > 0 Then
Dim workbook As IWorkbook = Nothing
Dim worksheet As ISheet = Nothing
workbook = ObjectIWorkBook
Using File As FileStream = New FileStream(pFilePath, FileMode.Open, FileAccess.ReadWrite)
Dim Ext As String = System.IO.Path.GetExtension(pFilePath)
Select Case Ext.ToLower()
Case ".xls"
workbook = New HSSFWorkbook(File)
Case ".xlsx"
workbook = New XSSFWorkbook(File)
End Select
worksheet = workbook.GetSheet(pDatos.TableName)
For Each DTrow As DataRow In pDatos.Rows
Dim SheetRow As IRow = worksheet.GetRow(StartWrite)
If Not IsNothing(SheetRow) AndAlso SheetRow.Cells.Count > 0 Then
Dim Avg As String = CalcAvg2(DTrow)
Dim iCol As Integer = 0
For Each column As DataColumn In pDatos.Columns
If column.Ordinal > 3 Then
If iCol = 7 Then
SheetRow.CreateCell(iCol).SetCellValue(Avg)
Dim Font = ObjectIWorkBook.CreateFont()
Font.FontHeightInPoints = 16
Font.FontName = "Arial"
SheetRow.Cells(iCol).CellStyle.SetFont(Font)
End If
Dim cell As ICell = SheetRow.Cells(iCol)
Dim cellValue As Object = DTrow(iCol)
If Not (cellValue.ToString) = Nothing Then
Select Case column.DataType.ToString()
Case "System.Double"
cell.SetCellValue(Convert.ToDouble(cellValue.ToString))
Case "System.String"
cell.SetCellValue(Convert.ToString(cellValue.ToString))
End Select
End If
End If
iCol += 1
Next
StartWrite += 1
End If
Next
workbook.Write(File)
File.Close()
End Using
End If
End Sub
'حساب معدلات التقييم
Private Function CalcAvg(Row As DataRow) As String
If Row IsNot Nothing Then
Dim Avg As Double = Nothing
If Row(4).ToString = Nothing Or IsNothing(Row(5).ToString) Or IsNothing(Row(6).ToString) Then
Avg = 0
Return Avg
End If
Avg = ((Row(4) + Row(5)) + (Row(6) * 3)) / 100
If 0 > Avg <= 7 Then
Row(7) = Avg1
ElseIf 7 > Avg <= 10 Then
Row(7) = Avg2
ElseIf 10 > Avg <= 12 Then
Row(7) = Avg3
ElseIf 12 > Avg <= 14 Then
Row(7) = Avg4
ElseIf 14 > Avg <= 16 Then
Row(7) = Avg5
ElseIf 16 > Avg <= 18 Then
Row(7) = Avg6
ElseIf 18 > Avg <= 20 Then
Row(7) = Avg7
End If
Return Avg
End If
Return Nothing
End Function
'حساب معدلات التقييم
Private Function CalcAvg2(Row As DataRow) As String
If Row IsNot Nothing Then
Dim Avg As Double = Nothing
If Row(4).ToString = Nothing Or IsNothing(Row(5).ToString) Or IsNothing(Row(6).ToString) Then
Avg = 0
Return Avg
End If
Avg = Row(6)
Select Case Avg
Case 0 To 7
Row(7) = Avg1
Case 7 To 10
Row(7) = Avg2
Case 10 To 12
Row(7) = Avg3
Case 12 To 14
Row(7) = Avg4
Case 14 To 16
Row(7) = Avg5
Case 16 To 18
Row(7) = Avg6
Case 18 To 20
Row(7) = Avg7
End Select
Return Avg
End If
Return Nothing
End Function
End Class
واضف له مديول Utilty الخاص بالرجستري موجود بالاعلى.
اضف نموذج جديد سميه Fr_Setting وضع عليه ادوات بالاسماء كما بالصورة
وضع الكود التالي بداخله
PHP كود :
'حفظ التغيرات
Private Sub btnSave_Click(sender As Object, e As EventArgs) Handles btnSave.Click
Avg1 = txtAvg1.Text
Avg2 = txtAvg2.Text
Avg3 = txtAvg3.Text
Avg4 = txtAvg4.Text
Avg5 = txtAvg5.Text
Avg6 = txtAvg6.Text
Avg7 = txtAvg7.Text
End Sub
'جلب التقديرات المحفوظة
Private Sub GetValuesFromReg()
If Not String.IsNullOrEmpty(ApplicationKeyName) Then
txtAvg1.Text = Avg1
txtAvg2.Text = Avg2
txtAvg3.Text = Avg3
txtAvg4.Text = Avg4
txtAvg5.Text = Avg5
txtAvg6.Text = Avg6
txtAvg7.Text = Avg7
End If
End Sub
Private Sub Fr_Setting_Load(sender As Object, e As EventArgs) Handles MyBase.Load
GetValuesFromReg()
End Sub
في النموذج الرئيسي عرف المتغيرات على مستوى النموذج
PHP كود :
Dim Wrk As IWorkbook
Dim ExlFile As New Cls_NPOI_Walker(Wrk)
Dim Ds As New DataSet
استدعي الدالة التالية في بداية الاقلاع
PHP كود :
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
GenerateRegistryKyes()
TxtPath_TextChanged(sender, e)
End Sub
في زر استيراد الاوراق ضع ما يلي
PHP كود :
ExlFile.ReadExcel(TxtPath.Text, Cmb_SheetName, Ds)
ضع زر خاص بالتصدير و اضف له الكود التالي
PHP كود :
ExlFile.DataTable_To_Excel(Ds.Tables(Cmb_SheetName.Text), TxtPath.Text, Col_NumUpDown.Value)
انا متأسف بشأن التقصير في الشرح اذا ان كل شيئ قد شرحته بشكل مفصل لكنه ضاع اثناء الرفع
بالتوفيق
اللهم لك الحمد كما ينبغي لجلال وجهك و عظيم سلطانك
في حل و ترحال