كود :
كود الفورم 1
Imports System.Data.OleDb
Public Class Form1
Public connection As New OleDb.OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=مسار قاعده البيانات")
Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
Try
Con.Open()
Dim cmd As New OleDbCommand("SELECT username FROM Staff", Con)
Dim dr As OleDbDataReader = cmd.ExecuteReader()
' إعداد خاصية AutoComplete
Dim col As New AutoCompleteStringCollection()
While dr.Read()
Dim uname As String = dr("username").ToString()
ComboBox1.Items.Add(uname)
col.Add(uname)
End While
' تفعيل AutoComplete
ComboBox1.AutoCompleteMode = AutoCompleteMode.SuggestAppend
ComboBox1.AutoCompleteSource = AutoCompleteSource.CustomSource
ComboBox1.AutoCompleteCustomSource = col
ComboBox1.Font = New Font("Arial", 11, FontStyle.Bold)
ComboBox1.Height = 300
dr.Close()
Con.Close()
Catch ex As Exception
MessageBox.Show("خطأ في تحميل المستخدمين: " & ex.Message)
End Try
End Sub
Private Sub Form1_Shown(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Shown
ComboBox1.Focus()
End Sub
Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
Try
Con.Open()
Dim cmd As New OleDbCommand("SELECT [ID] FROM [Staff] WHERE [username] = @username AND [password] = @password", Con)
cmd.Parameters.AddWithValue("@username", ComboBox1.Text)
cmd.Parameters.AddWithValue("@password", TextBox2.Text)
Dim font As New Font("Arial", 15, FontStyle.Bold)
Dim result = cmd.ExecuteScalar()
If result IsNot Nothing Then
IDUser = result
Form2.Show()
Me.Close()
Else
MessageBox.Show("اسم المستخدم أو كلمة المرور غير صحيحة ❌")
End If
Con.Close()
Catch ex As Exception
MessageBox.Show("خطأ: " & ex.Message)
End Try
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Me.Close()
End Sub
Private Sub CheckBox1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBox1.CheckedChanged
If CheckBox1.Checked = True Then
TextBox2.PasswordChar = ""
Else
TextBox2.PasswordChar = "•"
End If
End Sub
Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs)
If Label1.Left <= Me.Width - 20 Then
'Label1.Left += 1
Else
Label1.Left = -20
End If
End Sub
Private Sub Timer1_Tick_1(ByVal sender As System.Object, ByVal e As System.EventArgs)
If Label1.Left <= Me.Width - 20 Then
Label1.Left += 1
Else
Label1.Left = -20
End If
End Sub
End Class
فورم 2
Imports System.Data.OleDb
Public Class Form2
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Close()
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
'Dim command As New OleDb.OleDbCommand("Select Vote From Staff Where ID =@ID", connection)
'Dim IDX As New OleDb.OleDbParameter("@ID", IDUser)
'command.Parameters.Add(IDX)
'If command.Connection.State = ConnectionState.Closed Then command.Connection.Open()
'Dim Rreader As OleDb.OleDbDataReader = Nothing
'Dim fff As String = String.Empty
'fff = dt.Rows(0)(0).ToString
'MsgBox(IDUser)
'Rreader = FillDataReader("Select Vote From Staff Where ID =" & IDUser)
'Rreader.Read()
'fff = Rreader.GetValue(0).ToString
If FillDataTable("Select Vote From Staff Where ID =" & IDUser).Rows(0)(0).ToString.Length > 0 Then
MsgBox("هذا الموظف قد صوت مسبقا", MsgBoxStyle.Critical, "")
Else
Dim StrSQL As String = "UPDATE Staff SET Vote='" & Txt_Vote.Text & "' Where ID=" & IDUser
'Dim Cmd As New OleDbCommand(StrSQL, connection)
'If connection.State = ConnectionState.Closed Then connection.Open()
'Cmd.ExecuteNonQuery()
'connection.Close()
ExcuteNoneQuryXT(StrSQL)
MsgBox("تم التصويت للموظف : " & Txt_Vote.Text & " بنجاح", MsgBoxStyle.Information, "")
End If
End Sub
Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs)
Dim frm As New Form3
frm.Show()
Close()
End Sub
Private Sub Button3_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
'Dim command As New OleDb.OleDbCommand("Select Vote From Staff Where ID =@ID", connection)
'Dim IDX As New OleDb.OleDbParameter("@ID", IDUser)
'command.Parameters.Add(IDX)
'If command.Connection.State = ConnectionState.Closed Then command.Connection.Open()
'Dim Rreader As OleDb.OleDbDataReader = Nothing
'Dim fff As String = String.Empty
'fff = dt.Rows(0)(0).ToString
'MsgBox(IDUser)
'Rreader = FillDataReader("Select Vote From Staff Where ID =" & IDUser)
'Rreader.Read()
'fff = Rreader.GetValue(0).ToString
If FillDataTable("Select Vote From Staff Where ID =" & IDUser).Rows(0)(0).ToString.Length > 0 Then
MsgBox("هذا الموظف قد صوت مسبقا", MsgBoxStyle.Critical, "")
Else
Dim StrSQL As String = "UPDATE Staff SET Vote='" & Txt_Vote.Text & "' Where ID=" & IDUser
'Dim Cmd As New OleDbCommand(StrSQL, connection)
'If connection.State = ConnectionState.Closed Then connection.Open()
'Cmd.ExecuteNonQuery()
'connection.Close()
ExcuteNoneQuryXT(StrSQL)
MsgBox("تم التصويت للموظف : " & Txt_Vote.Text & " بنجاح", MsgBoxStyle.Information, "")
End If
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim frm As New Form3
frm.Show()
Close()
End Sub
Private Sub Button2_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Close()
End Sub
Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
End Sub
End Class
المودل
Imports System.Data.OleDb
Module Module1
Public IDUser As Integer
Public connection As New OleDb.OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=مسار قاعده البيانات")
Sub ExcuteNoneQuryXT(ByVal strSQL As String)
Dim Cmd As New OleDb.OleDbCommand(strSQL, Con)
If Con.State = ConnectionState.Closed Then Con.Open()
Cmd.ExecuteNonQuery()
If Con.State = ConnectionState.Open Then Con.Close()
'هذه الطريقة جيدة لاضافة و تعديل السجلات
End Sub
Public Con As New OleDb.OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=مسار قاعده البيانات")
Function FillDataReader(ByVal Qquery As String) As OleDbDataReader
Dim Cmd As New OleDbCommand(Qquery, Con)
Dim Rreader As OleDbDataReader = Nothing
If Con.State = ConnectionState.Closed Then Con.Open()
Rreader = Cmd.ExecuteReader()
Return Rreader
'استخدم طريقة الاتصال المنفصل أفل منها
End Function
Function FillDataTable(ByVal Qquery As String) As DataTable
Dim da As New OleDbDataAdapter(Qquery, Con)
Dim DT As New DataTable
DT.Clear()
da.Fill(DT)
Return DT
'هذه الطريقة جيدة لعرض السجلات عن طريق الداتاتيبل
'طريقة الاتصال المنفصل
End Function
End Moduleالمشروع مرتبط بقاعده بيانات اكسس وكل شي تمام اريد اضيف صلاحيه كمسئولين لعده يوزرات عند الدخول من الفورم 1 يدخولوا على الفورم 2 بصلاحيه في البوتون 4 الذي يظهر لهم فقط وهي تصدير البيانات الى اكسل ، اما المستخدمين العادين فيكون دخوله طبيعي من دون الاطلاع الى تصدير البيانات .
موضح لكم صوره اكثر توضيحاً
اللهمّ بعلمك الغيب وقدرتك على الخلق، أحييني ما علمت الحياة خيراً لي، وتوفّني ما علمت الوفاة خيراً لي.
