• 0
hero92

أرغب فى تعديل الكود الى كود VB.net2012 

سؤال

السلام عليكم 

أرغب فى تعديل الكود الى كود VB.net2012 

تحياتى

Private Sub a18_Click()

On Error GoTo err_cmd_Export_to_pdf_Click

Dim rst As DAO.Recordset



myCriteria = "[Batchname]=" & DateFormat(Me.Idate)
myCriteria = myCriteria & " And [Error]='" & Me.iLe & "'"
myCriteria = myCriteria & " And [CertificateType]='" & Me.iMod & "'"


Set rst = CurrentDb.OpenRecordset("select DISTINCT [CenterCode], [Batchname] as D1, [Error], [CertificateType] as M1 From candidabozala Where " & myCriteria)
rst.MoveLast: rst.MoveFirst
RC = rst.RecordCount



For I = 1 To RC

Me.iIDD = rst!CenterCode


If DCount("*", "CIT") <> 0 Then

Output_Path = "\\Storagea\Cambridge IT\CIT Management\Batchname\7M\College\" & rst!CenterCode


DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "CIT", Output_Path, True

End If

rst.MoveNext
Next I


Me.iIDD = ""
rst.Close: Set rst = Nothing

MsgBox "Excel Exporting completed"



cmd_Export_to_pdf_Click_Exit:
Exit Sub

err_cmd_Export_to_pdf_Click:

If Err.number = 3021 Then
MsgBox "No Records to Print"
Resume cmd_Export_to_pdf_Click_Exit
Else
MsgBox Error$
End If
End Sub

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

13 إجابة على هذا السؤال .

  • 0

السلام عليكم ورحمة الله وبركاته

علي ما اعتقد CIT هو استعلام يقرا قيمة Me.iIDD

اذا كان هكذا يكون الكود كالاتي

 Sub Main()
            Dim sConnectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\\contactmanagement.mdb"
            Dim myCriteria As String
        myCriteria = "[Batchname]=" & DateFormat(Me.Idate)
        myCriteria = myCriteria & " And [Error]='" & Me.iLe & "'"
        myCriteria = myCriteria & " And [CertificateType]='" & Me.iMod & "'"

            Dim sSql As String = "select DISTINCT [CenterCode], [Batchname] as D1, [Error], [CertificateType] as M1 From candidabozala Where " & myCriteria
            Dim oConnection As OleDbConnection = New OleDbConnection(sConnectionString)
            Dim oCommand As OleDbCommand = New OleDbCommand(sSql, oConnection)
        Dim oDataReader As OleDbDataReader = Nothing

        Try
            oConnection.Open()
            oDataReader = oCommand.ExecuteReader()
            If oDataReader.HasRows Then
                While oDataReader.Read()

                    Dim sOutputPath As String = "\\Storagea\Cambridge IT\CIT Management\Batchname\7M\College\" & oDataReader("CenterCode").ToString()

                    Dim oDataAdapter As OleDbDataAdapter = New OleDbDataAdapter("select * from cte where =CenterCode" & oDataReader("CenterCode").ToString(), oConnection)
                    Dim oDataTable As DataTable = New DataTable
                    oDataAdapter.Fill(oDataTable)
                    DatatableToExcel(oDataTable, sOutputPath)
                End While
                MsgBox("Excel Exporting completed")
            Else
                MsgBox("No Records to Print")
            End If
        Catch ae As OleDbException
            MsgBox(ae.Message())
        Catch ae As Exception
            MsgBox(ae.Message())
        Finally
            oDataReader.Close()
            oConnection.Close()
        End Try

    End Sub
    Private Sub DatatableToExcel(ByVal dtTemp As DataTable, ByVal strFileName As String)
        Dim _excel As New Microsoft.Office.Interop.Excel.Application
        Dim wBook As Microsoft.Office.Interop.Excel.Workbook
        Dim wSheet As Microsoft.Office.Interop.Excel.Worksheet

        wBook = _excel.Workbooks.Add()
        wSheet = wBook.ActiveSheet()

        Dim dt As System.Data.DataTable = dtTemp
        Dim dc As System.Data.DataColumn
        Dim dr As System.Data.DataRow
        Dim colIndex As Integer = 0
        Dim rowIndex As Integer = 0

        For Each dc In dt.Columns
            colIndex = colIndex + 1
            _excel.Cells(1, colIndex) = dc.ColumnName
        Next

        For Each dr In dt.Rows
            rowIndex = rowIndex + 1
            colIndex = 0
            For Each dc In dt.Columns
                colIndex = colIndex + 1
                _excel.Cells(rowIndex + 1, colIndex) = dr(dc.ColumnName)
            Next
        Next

        wSheet.Columns.AutoFit()
        If System.IO.File.Exists(strFileName) Then
            System.IO.File.Delete(strFileName)
        End If

        wBook.SaveAs(strFileName)
        wBook.Close()
        _excel.Quit()
    End Sub

 

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

عليكم السلام ورحمة الله وبركاته

الاستاذ  الفاضل / كرم

اولا احب ان اشكرك على الرد 

نعم بالفعل CIT هو استعلام   فى قاعدة بيانات اكسس   وقيمة  Me.iIDD   هى عبارة عن ارقام امام البيانات ليتم تجميع الارقام المتشابه مع بعض فى ملف اكسل 

 

تم عمل قاعدة بيانات جديدة بال Sql Sever وتم ربطها ب VB.net  لكثرة البيانات بشكل كبير جدا

وارغب فى تنفيذ نفس الكود على النظام الجديد ب 2012 Sql Sever  + VB.net   و لكن لم اتمكن من تنفيذ الكود على النظام الجديد بشكل كامل بعد التعديل

والهدف من الكود لدى بيانات فى datagridview ارغب فى تصديرها لملفات اكسل و لكن بشروط   يتم تحديد الشروط فى فورم بأختيار (التاريخ والناجحين والنوع ) وبعد ذلك يتم الضغط على زر  يتم انشاء ملفات اكسل لكل رقم بالشروط المحدده وحفظه بأسم الرقم  فى مجلد

ارجو المساعدة لعمل نفس الاجراء على النظام الجديد

تقبل خالص تحياتى

 

 

 

تم تعديل بواسطه hero92
A
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

جرب الكود السابق مع تعدل قاعدة البيانات

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

استاذى الفاضل

تم تجربة الكود مع تعديل قاعدة البيانات ولم ينجح الامر

الكود بعد التعديل   يظهر خطأ ولم يعمل مرفق صور الخطأ

تقبل خالص تحياتى
   

Public Sub Main()
        Dim sConnectionString As String = ("Data Source=.;Initial Catalog=Users;Persist Security Info=True;User ID=sa;Password=123")
        Dim myCriteria As String
        myCriteria = "[Batchname]=" & (Me.Idate.Value)
        myCriteria = myCriteria & " And [Error]='" & Me.iLe.Text & "'"
        myCriteria = myCriteria & " And [CertificateType]='" & Me.iMod.Text & "'"

        Dim sSql As String = "select DISTINCT [CenterCode], [Batchname] as D1, [Error], [CertificateType] as M1 From candidaboz Where" & myCriteria
        Dim oConnection As SqlConnection = New SqlConnection(sConnectionString)
        Dim oCommand As SqlCommand = New SqlCommand(sSql, oConnection)
        Dim oDataReader As SqlDataReader = Nothing

        Try
            oConnection.Open()
            oDataReader = oCommand.ExecuteReader()
            If oDataReader.HasRows Then
                While oDataReader.Read()

                    Dim sOutputPath As String = "D:\DATABASE" & oDataReader("CenterCode").ToString()

                    Dim oDataAdapter As SqlDataAdapter = New SqlDataAdapter("select * from CIT where =CenterCode" & oDataReader("CenterCode").ToString(), oConnection)
                    Dim oDataTable As DataTable = New DataTable
                    oDataAdapter.Fill(oDataTable)
                    DatatableToExcel(oDataTable, sOutputPath)
                End While
                MsgBox("Excel Exporting completed")
            Else
                MsgBox("No Records to Print")
            End If
        Catch ae As SqlException
            MsgBox(ae.Message())
        Catch ae As Exception
            MsgBox(ae.Message())
        Finally
            oDataReader.Close()
            oConnection.Close()
        End Try
    End Sub
    Private Sub DatatableToExcel(ByVal dtTemp As DataTable, ByVal strFileName As String)
        Dim _excel As New Microsoft.Office.Interop.Excel.Application
        Dim wBook As Microsoft.Office.Interop.Excel.Workbook
        Dim wSheet As Microsoft.Office.Interop.Excel.Worksheet

        wBook = _excel.Workbooks.Add()
        wSheet = wBook.ActiveSheet()

        Dim dt As System.Data.DataTable = dtTemp
        Dim dc As System.Data.DataColumn
        Dim dr As System.Data.DataRow
        Dim colIndex As Integer = 0
        Dim rowIndex As Integer = 0

        For Each dc In dt.Columns
            colIndex = colIndex + 1
            _excel.Cells(1, colIndex) = dc.ColumnName
        Next

        For Each dr In dt.Rows
            rowIndex = rowIndex + 1
            colIndex = 0
            For Each dc In dt.Columns
                colIndex = colIndex + 1
                _excel.Cells(rowIndex + 1, colIndex) = dr(dc.ColumnName)
            Next
        Next

        wSheet.Columns.AutoFit()
        If System.IO.File.Exists(strFileName) Then
            System.IO.File.Delete(strFileName)
        End If

        wBook.SaveAs(strFileName)
        wBook.Close()
        _excel.Quit()

    End Sub

Capture.PNG

Capture1.PNG

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

ممكن ترفق المشروع وجدولين من قاعد البيانات

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

تفضل أستاذى العزيز

مرفق المشروع 
وصورة توضح الاعمدة التى يتم عليها الشروط 

تقبل خالص تحياتى 

Students1.rar

Capture2.PNG

تم تعديل بواسطه hero92
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

تم تعديل الملف اتمني ان يكون الحل

 

Students1Update.rar

Students1a.png

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

استاذى الفاضل  جزاك الله خيرا

أحب ان اشكرك على مجهودك العظيم 

يوجد لدى بعض النقاط ارغب فى التعديل عليها 

1 - بعد تحديد الشروط وعمل Export تم تجميع جميع الارقام المطابقة عليها الشروط ثم وضعها فى ملف اكسل واحد  

المطلوب هو انشاء ملف اكسل لكل رقم  بمعنى يتم تجميع كل TAG200 فى ملف اكسل واحد و TAG500 فى ملف اكسل واحد

 2 - تم تحديد المسار فى الكود بهذا الشكل "D:\Hero92" عند تصدير ملفات الاكسل لم يضع ملفات الاكسل فى المجلد المحدد فى المسار بل وضع ملفات الاكسل فى الــ D: بشكل مباشر و تم انشاء اسم ملف الاكسل بهذا الشكل (Hero92TAG200)  

ارغب فى ان يضع ملفات الاكسل فى المجلد المحدد فى المسار ويكون اسم ملف الاكسل رقم العمود فقط  (TAG200)

3 - أرغب فى تحديد التاريخ ضمن الشروط 

تقبل خالص تحياتى 

 

Capture.JPG

تم تعديل بواسطه hero92
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

علي فكر انا مش شاطر في VB

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim connuser As New SqlConnection("Data Source=PC\SQLEXPRESS12;Initial Catalog=Std;Persist Security Info=True;User ID=it;Password=123")
        Dim dtMainData As New DataTable

        Dim myCriteria As String = " WHERE "
        myCriteria = myCriteria & "[SCType]='" & Me.imFF.SelectedValue.Trim & "'"
        myCriteria = myCriteria & " And [Error]='" & Me.iLe.SelectedValue.Trim & "'"

        If Idate.Text.Length > 0 And IsDate(Idate.Text) Then
            myCriteria = myCriteria & " And Batchname='" & Idate.Text & "'"
        End If

        Dim CMD As New SqlCommand("Select * From candidab" & myCriteria, connuser)
        connuser.Open()
        dtMainData.Load(CMD.ExecuteReader)
        connuser.Close()
        CMD = Nothing
        If dtMainData.Rows.Count > 0 Then
            DataGridView1.DataSource = dtMainData
            Dim sMainPath As String = "c:\Hero92\"

            Dim oListFileName = (From u In dtMainData.AsEnumerable() _
                                 Select u.Field(Of String)("CenterCode")).Distinct()

            For Each CenterCode As String In oListFileName
                Dim dtData As DataTable = dtMainData.Select("CenterCode='" & CenterCode & "'").CopyToDataTable

                DatatableToExcel(dtData, sMainPath & CenterCode)
            Next

            MsgBox("Excel Exporting completed")
        Else
            MsgBox("No Records to Print")
        End If
    End Sub

بالتوفيق

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

 الف شكر استاذنا الفاضل
زادك الله علما ونورا

جعله الله فى ميزان حسناتك

ونأسف على كثرة الاسئلة وانا بحاول اتعلم من الاستاذة الافاضل والخبراء الذى مثلك

تقبل تحياتى

تم تعديل بواسطه hero92
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

اكرمك الله

ليس استاذ بل بحث نت هههههههههه كلنا نساعد بعض

بالتوفيق

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

بارك الله فيك

ههههههههه  والله قمت التواضع 

تقبل خالص تحياتى

قال رسول الله صلى الله عليه وسلم: " من سعى لأخيه المسلم في حاجة، فقضيت له أو لم تقض غفر الله له ما تقدم من ذنبه وما تأخر، وكتب له براءتان براءة من النار وبراءة من النفاق.

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

اكرمك الله

 

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان

  • يستعرض القسم حالياً   0 members

    لا يوجد أعضاء مسجلين يشاهدون هذه الصفحة .