1005

Dim p As Boolean

Private Sub CommandButton1_Click()
    If p = False Then
        ListBox1.ListIndex = 0
        Me!ListBox1.Selected(0) = False
        p = True
    End If
 
    Dim com5 As New Ani5
    Dim sql As String
    sql = "select * from scoredata"
 
    Dim kdata
 
    kdata = com5.dataload(sql, "persondb", "12345678")
 
    Dim listr As Integer
    Dim j As Integer
 
    listr = UBound(kdata, 1)
    ListBox1.Clear
     
 
    For j = 0 To listr - 1 Step 1
        ListBox1.AddItem kdata(j, 0)
        ListBox1.List(j, 1) = kdata(j, 1)
        ListBox1.List(j, 2) = kdata(j, 2)
        ListBox1.List(j, 3) = kdata(j, 3)
        ListBox1.List(j, 4) = kdata(j, 4)
        ListBox1.List(j, 5) = kdata(j, 5)
    Next j
 
    If p = True Then
        Me!ListBox1.Selected(0) = True
        ListBox1.SetFocus
        p = False
    End If
     
End Sub

Private Sub CommandButton2_Click()
   'Me!ListBox1.Selected(j) = False
    TextBox1.Text = ""
    TextBox2.Text = ""
    TextBox3.Text = ""
    TextBox4.Text = ""
    TextBox5.Text = ""
    TextBox6.Text = ""
End Sub
=======================
Private Sub ListBox1_Change()
    Dim j As Integer
    j = ListBox1.ListIndex
 
    If p = True Then
        TextBox1.Text = ListBox1.List(j, 0)
        TextBox2.Text = ListBox1.List(j, 1)
        TextBox3.Text = ListBox1.List(j, 2)
        TextBox4.Text = ListBox1.List(j, 3)
        TextBox5.Text = ListBox1.List(j, 4)
        TextBox6.Text = ListBox1.List(j, 5)
    End If
End Sub
Private Sub UserForm_Activate()
   p = True
End Sub
=============================
1.ListBox1_keyDown(byval keycode as MsForms.ReturnInteger,byval shift as integer)
                                                                     回傳整數                              組合鍵

  End Sub
2.ListBox1_keyUp(byval keycode as MsForms.ReturnInteger,byval shift as integer)
                                                                     回傳整數                              組合鍵

  End Sub
* keycode  鍵盤ASCII碼
         上18
左37                右39
          下40
==================================================================
1.ListBox1_Change(): 遮罩變動後立即反應事件
  變動量  change和ListBox1內部是關聯的
2.ListBox1_Click(): mouse點擊ListBox1記錄列所觸發事件  VBA error  
點擊 click和ListBox1內部是關聯的
3.兩者若同時存在已change為優先
===========================================
Dim p As Boolean
Dim p2 As Boolean

Private Sub CommandButton1_Click()
    p2 = False

    If p = False Then
        ListBox1.ListIndex = 0
        Me!ListBox1.Selected(0) = False
        p = True
    End If
 
    Dim com5 As New Ani5
    Dim sql As String
    sql = "select * from scoredata"
 
    Dim kdata
 
    kdata = com5.dataload(sql, "persondb", "12345678")
 
    Dim listr As Integer
    Dim j As Integer
 
    listr = UBound(kdata, 1)
    ListBox1.Clear
     
 
    For j = 0 To listr - 1 Step 1
        ListBox1.AddItem kdata(j, 0)
        ListBox1.List(j, 1) = kdata(j, 1)
        ListBox1.List(j, 2) = kdata(j, 2)
        ListBox1.List(j, 3) = kdata(j, 3)
        ListBox1.List(j, 4) = kdata(j, 4)
        ListBox1.List(j, 5) = kdata(j, 5)
    Next j
 
    If p = True Then
        Me!ListBox1.Selected(0) = True
        ListBox1.SetFocus
        p = False
    End If
     
End Sub

Private Sub CommandButton2_Click()
   'Me!ListBox1.Selected(j) = False
    TextBox1.Text = ""
    TextBox2.Text = ""
    TextBox3.Text = ""
    TextBox4.Text = ""
    TextBox5.Text = ""
    TextBox6.Text = ""
End Sub

=============

Private Sub ListBox1_Change()

    Dim j As Integer

    j = ListBox1.ListIndex

    

    If p = True Then

        TextBox1.Text = ListBox1.List(j, 0)

        TextBox2.Text = ListBox1.List(j, 1)

        TextBox3.Text = ListBox1.List(j, 2)

        TextBox4.Text = ListBox1.List(j, 3)

        TextBox5.Text = ListBox1.List(j, 4)

        TextBox6.Text = ListBox1.List(j, 5)

    End If

    

    If p2 = True Then

        TextBox1.Text = ListBox1.List(j, 0)

        TextBox2.Text = ListBox1.List(j, 1)

        TextBox3.Text = ListBox1.List(j, 2)

        TextBox4.Text = ListBox1.List(j, 3)

        TextBox5.Text = ListBox1.List(j, 4)

        TextBox6.Text = ListBox1.List(j, 5)

    End If

End Sub

====================

Private Sub ListBox1_Click()

   Dim j As Integer

   j = ListBox1.ListIndex

   TextBox1.Text = ListBox1.List(j, 0)

   TextBox2.Text = ListBox1.List(j, 1)

   TextBox3.Text = ListBox1.List(j, 2)

   TextBox4.Text = ListBox1.List(j, 3)

   TextBox5.Text = ListBox1.List(j, 4)

   TextBox6.Text = ListBox1.List(j, 5)

End Sub

==========================================

Private Sub ListBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    If KeyCode = 38 Then

        p2 = True

    End If

    

    If KeyCode = 40 Then

        p2 = True

    End If

End Sub

Private Sub UserForm_Activate()

   p = True

   p2 = False

End Sub

======================

查詢
1.sql直接寫在表單
2.sql 語法寫在資料庫管理介面，而不寫在表單，為了網路安全保護資料庫

CREATE PROCEDURE `pid2`(IN `id` VARCHAR(50))
LANGUAGE SQL
NOT DETERMINISTIC
CONTAINS SQL
SQL SECURITY DEFINER
COMMENT ''
BEGIN
select * from scoredata where 學號=id;
END

CREATE PROCEDURE `pname`(IN `name` VARCHAR(50))
LANGUAGE SQL
NOT DETERMINISTIC
CONTAINS SQL
SQL SECURITY DEFINER
COMMENT ''
BEGIN
select * from scoredata where 姓名=name;
END
=======================================

Dim p As Boolean
Dim p2 As Boolean

Private Sub CommandButton1_Click()
    Dim sql As String
    sql = "select * from scoredata"
    Call loaddata(sql)
End Sub

Private Sub CommandButton2_Click()
   'Me!ListBox1.Selected(j) = False
    TextBox1.Text = ""
    TextBox2.Text = ""
    TextBox3.Text = ""
    TextBox4.Text = ""
    TextBox5.Text = ""
    TextBox6.Text = ""
End Sub

Private Sub CommandButton3_Click()
    On Error GoTo la1
    Dim com5 As New Ani5
    Dim sql As String
    Dim no, name As String
    Dim c1, c2, c3, c4 As Integer
 
    no = TextBox1.Text
    name = TextBox2.Text
    c1 = CInt(TextBox3.Text)
    c2 = CInt(TextBox4.Text)
    c3 = CInt(TextBox5.Text)
    c4 = CInt(TextBox6.Text)
 
    sql = "insert into scoredata values('" & no & "','" & name & "'," & c1 & "," & c2 & "," & c3 & "," & c4 & ")"
    com5.modifydata sql:=sql, dn:="persondb", pw:="12345678"
    Exit Sub
la1:
    MsgBox "學號不可重複或資料不完整"
End Sub
Sub loaddata(ByVal sql As String)
    p2 = False

    If p = False Then
        ListBox1.ListIndex = 0
        Me!ListBox1.Selected(0) = False
        p = True
    End If
 
    Dim com5 As New Ani5
    'Dim sql As String
 
    'sql = "select * from scoredata"
    Dim kdata
 
    kdata = com5.dataload(sql, "persondb", "12345678")
 
    Dim listr As Integer
    Dim j As Integer
 
    listr = UBound(kdata, 1)
    ListBox1.Clear
     
 
    For j = 0 To listr - 1 Step 1
        ListBox1.AddItem kdata(j, 0)
        ListBox1.List(j, 1) = kdata(j, 1)
        ListBox1.List(j, 2) = kdata(j, 2)
        ListBox1.List(j, 3) = kdata(j, 3)
        ListBox1.List(j, 4) = kdata(j, 4)
        ListBox1.List(j, 5) = kdata(j, 5)
    Next j
 
    If p = True Then
        Me!ListBox1.Selected(0) = True
        ListBox1.SetFocus
        p = False
    End If
     
End Sub
Private Sub CommandButton4_Click()
    Dim id As String
    Dim sql As String
 
    If TextBox7.Text <> "" Then
        id = TextBox7.Text
        sql = "call pid2 ('" & id & "')"
        Call loaddata(sql)
    Else
        MsgBox "請輸入學號資料"
    End If
 
End Sub

Private Sub CommandButton5_Click()
    Dim name As String
    Dim sql As String
 
    If TextBox8.Text <> "" Then
        name = TextBox8.Text
        sql = "call pname ('" & name & "')"
        Call loaddata(sql)
    Else
        MsgBox "請輸入姓名資料"
    End If
End Sub

Private Sub ListBox1_Change()
    Dim j As Integer
    j = ListBox1.ListIndex
 
    If p = True Then
        TextBox1.Text = ListBox1.List(j, 0)
        TextBox2.Text = ListBox1.List(j, 1)
        TextBox3.Text = ListBox1.List(j, 2)
        TextBox4.Text = ListBox1.List(j, 3)
        TextBox5.Text = ListBox1.List(j, 4)
        TextBox6.Text = ListBox1.List(j, 5)
    End If
 
    If p2 = True Then
        TextBox1.Text = ListBox1.List(j, 0)
        TextBox2.Text = ListBox1.List(j, 1)
        TextBox3.Text = ListBox1.List(j, 2)
        TextBox4.Text = ListBox1.List(j, 3)
        TextBox5.Text = ListBox1.List(j, 4)
        TextBox6.Text = ListBox1.List(j, 5)
    End If
End Sub

Private Sub ListBox1_Click()
   Dim j As Integer
   j = ListBox1.ListIndex
   TextBox1.Text = ListBox1.List(j, 0)
   TextBox2.Text = ListBox1.List(j, 1)
   TextBox3.Text = ListBox1.List(j, 2)
   TextBox4.Text = ListBox1.List(j, 3)
   TextBox5.Text = ListBox1.List(j, 4)
   TextBox6.Text = ListBox1.List(j, 5)
End Sub

Private Sub ListBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 38 Then
        p2 = True
    End If
 
    If KeyCode = 40 Then
        p2 = True
    End If
End Sub

Private Sub UserForm_Activate()
   p = True
   p2 = False
End Sub

1003

https://msdn.microsoft.com/en-us/library/office/ff845049.aspx

Private Sub CommandButton3_Click()
    On Error GoTo la1
    Dim com5 As New Ani5
    Dim sql As String
    Dim no, name As String
    Dim c1, c2, c3, c4 As Integer
   
    no = TextBox1.Text
    name = TextBox2.Text
    c1 = CInt(TextBox3.Text)
    c2 = CInt(TextBox4.Text)
    c3 = CInt(TextBox5.Text)
    c4 = CInt(TextBox6.Text)
   
    sql = "insert into scoredata values('" & no & "','" & name & "'," & c1 & "," & c2 & "," & c3 & "," & c4 & ")"
    com5.modifydata sql:=sql, dn:="persondb", pw:="12345678"
    Exit Sub
la1:
    MsgBox "學號不可重複或資料不完整"
End Sub
======================================================
Public Function modifydata(ByVal sql As String, ByVal dn As String, ByVal pw As String)
    Dim conn As New ADODB.Connection  '資料庫連線
    Dim rs As New ADODB.Recordset     '資料集
   
    ConnectionString = "driver={mysql odbc 5.1 driver};database=" & dn & ";server=127.0.0.1;port=3306;uid=root;password=" & pw & ";opt=3;smt=SET NAMES 'gb2312'"
    conn.Open ConnectionString
    rs.Open sql, conn
   
    MsgBox "功能執行完成"
    conn.Close
   
    Set rs = Nothing
    Set conn = Nothing
End Function

=====================================

0930

進階資料庫語言
1.視圖
2.預存程序
3.預存函數
4.觸發器
5.指標 存儲過程用
6.事件

視圖 view  HeidiSQL_9.3_Portable
預存程序

Public Function dataload(ByVal sql As String, ByVal dbname As String, ByVal pw As String) As String()
    Dim conn As New ADODB.Connection  '資料庫連線
    Dim rs As New ADODB.Recordset     '資料集
   
    ConnectionString = "driver={mysql odbc 5.1 driver};database=" & dbname & ";server=127.0.0.1;port=3306;uid=root;password=" & pw & ";opt=3;smt=SET NAMES 'gb2312'"
    conn.Open ConnectionString
    rs.Open sql, conn
           
    Dim r As Integer
    Dim f As Integer
    rs.MoveFirst
    Do While Not rs.EOF
       r = r + 1       '取得總計錄數
       rs.MoveNext
    Loop
    f = rs.Fields.Count  '取得總欄位數
   
    ReDim kdata(r, f) As String  '設定二維動態陣列
   
    Dim p As Integer
    Dim i As Integer
    p = 0
    rs.MoveFirst
    Do While Not rs.EOF
       For i = 0 To f - 1 Step 1
        kdata(p, i) = rs(i)
       Next
       p = p + 1
       rs.MoveNext
    Loop
       rs.Close
       conn.Close
     
       dataload = kdata
     
End Function
======================================
Private Sub CommandButton1_Click()
    Dim com5 As New Ani5
    Dim sql As String
    sql = "select * from scoredata"
   
    Dim kdata
   
    kdata = com5.dataload(sql, "persondb", "12345678")
   
    Dim listr As Integer
    Dim j As Integer
   
    listr = UBound(kdata, 1)
    ListBox1.Clear
   
    For j = 0 To listr - 1 Step 1
        ListBox1.AddItem kdata(j, 0)
        ListBox1.List(j, 1) = kdata(j, 1)
        ListBox1.List(j, 2) = kdata(j, 2)
        ListBox1.List(j, 3) = kdata(j, 3)
        ListBox1.List(j, 4) = kdata(j, 4)
        ListBox1.List(j, 5) = kdata(j, 5)
    Next j
       
End Sub

0919

sql = "delete from persondata where 編號='" + id + "'"

Private Sub CommandButton5_Click()
    Dim id, sql As String
 
 
    If TextBox6.Text <> "" Then
        id = TextBox1.Text
        sql = "delete from persondata where 編號='" + id + "'"
        modifydata (sql)
        MsgBox "已執行刪除"
    Else
        MsgBox "請進行查詢後再執行刪除"
    End If
 
End Sub

==================================
Public Function modifydata(ByVal sql As String)
    On Error GoTo Label2
     
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
 
    ConnectionString = "driver={mysql odbc 5.1 driver};database=persondb;server=127.0.0.1;port=3306;uid=root;password=12345678;opt=3;smt=SET NAMES 'gb2312'"
    conn.Open ConnectionString
 
    rs.Open sql, conn
 

    conn.Close
    Set rs = Nothing
    Set conn = Nothing
 
   
    Exit Function
Label2:
    MsgBox "此筆資料已存在"
    cleardata
End Function
==================================================

sql = "update persondata set 編號='" + id + "',姓名='" + name + "',血型='" + blood + "',學歷='" + school + "',職務='" + work + "' where 編號='" + id + "'"

where 編號='" + id + "'    為固定指標
=========================================
Private Sub CommandButton4_Click()
    Dim sql As String
    Dim id As String
    Dim name As String
    Dim blood As String
    Dim school As String
    Dim work As String
 
 
    If TextBox6.Text <> "" Then
     
        id = TextBox1.Text
        name = TextBox2.Text
        blood = TextBox3.Text
        school = TextBox4.Text
        work = TextBox5.Text
        sql = "update persondata set 編號='" + id + "',姓名='" + name + "',血型='" + blood + "',學歷='" + school + "',職務='" + work + "' where 編號='" + id + "'"
        modifydata (sql)
     
        Dim s As String
        s = "select * from persondata"
        Worksheets("工作表2").displaydata (s)
     
    Else
        MsgBox "請進行查詢後再執行更新"
    End If
End Sub
=============================
MutiPage元件:
標題1  標題2  標題3
(pages(0)  pages(1)  pages(2)

Mutipage1.pages(0).caption="標題"
Mutipage1.value=0     啟動時預設頁面

0919

sql = "delete from persondata where 編號='" + id + "'"

Private Sub CommandButton5_Click()
    Dim id, sql As String
 
 
    If TextBox6.Text <> "" Then
        id = TextBox1.Text
        sql = "delete from persondata where 編號='" + id + "'"
        modifydata (sql)
        MsgBox "已執行刪除"
    Else
        MsgBox "請進行查詢後再執行刪除"
    End If
 
End Sub

==================================
Public Function modifydata(ByVal sql As String)
    On Error GoTo Label2
     
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
 
    ConnectionString = "driver={mysql odbc 5.1 driver};database=persondb;server=127.0.0.1;port=3306;uid=root;password=12345678;opt=3;smt=SET NAMES 'gb2312'"
    conn.Open ConnectionString
 
    rs.Open sql, conn
 

    conn.Close
    Set rs = Nothing
    Set conn = Nothing
 
   
    Exit Function
Label2:
    MsgBox "此筆資料已存在"
    cleardata
End Function
==================================================

sql = "update persondata set 編號='" + id + "',姓名='" + name + "',血型='" + blood + "',學歷='" + school + "',職務='" + work + "' where 編號='" + id + "'"

where 編號='" + id + "'    為固定指標
=========================================
Private Sub CommandButton4_Click()
    Dim sql As String
    Dim id As String
    Dim name As String
    Dim blood As String
    Dim school As String
    Dim work As String
 
 
    If TextBox6.Text <> "" Then
     
        id = TextBox1.Text
        name = TextBox2.Text
        blood = TextBox3.Text
        school = TextBox4.Text
        work = TextBox5.Text
        sql = "update persondata set 編號='" + id + "',姓名='" + name + "',血型='" + blood + "',學歷='" + school + "',職務='" + work + "' where 編號='" + id + "'"
        modifydata (sql)
     
        Dim s As String
        s = "select * from persondata"
        Worksheets("工作表2").displaydata (s)
     
    Else
        MsgBox "請進行查詢後再執行更新"
    End If
End Sub
=============================
MutiPage元件:
標題1  標題2  標題3
(pages(0)  pages(1)  pages(2)

Mutipage1.pages(0).caption="標題"
Mutipage1.value=0     啟動時預設頁面

0919

sql = "delete from persondata where 編號='" + id + "'"

Private Sub CommandButton5_Click()
    Dim id, sql As String
 
 
    If TextBox6.Text <> "" Then
        id = TextBox1.Text
        sql = "delete from persondata where 編號='" + id + "'"
        modifydata (sql)
        MsgBox "已執行刪除"
    Else
        MsgBox "請進行查詢後再執行刪除"
    End If
 
End Sub

==================================
Public Function modifydata(ByVal sql As String)
    On Error GoTo Label2
     
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
 
    ConnectionString = "driver={mysql odbc 5.1 driver};database=persondb;server=127.0.0.1;port=3306;uid=root;password=12345678;opt=3;smt=SET NAMES 'gb2312'"
    conn.Open ConnectionString
 
    rs.Open sql, conn
 

    conn.Close
    Set rs = Nothing
    Set conn = Nothing
 
   
    Exit Function
Label2:
    MsgBox "此筆資料已存在"
    cleardata
End Function
==================================================

sql = "update persondata set 編號='" + id + "',姓名='" + name + "',血型='" + blood + "',學歷='" + school + "',職務='" + work + "' where 編號='" + id + "'"

where 編號='" + id + "'    為固定指標
=========================================
Private Sub CommandButton4_Click()
    Dim sql As String
    Dim id As String
    Dim name As String
    Dim blood As String
    Dim school As String
    Dim work As String
 
 
    If TextBox6.Text <> "" Then
     
        id = TextBox1.Text
        name = TextBox2.Text
        blood = TextBox3.Text
        school = TextBox4.Text
        work = TextBox5.Text
        sql = "update persondata set 編號='" + id + "',姓名='" + name + "',血型='" + blood + "',學歷='" + school + "',職務='" + work + "' where 編號='" + id + "'"
        modifydata (sql)
     
        Dim s As String
        s = "select * from persondata"
        Worksheets("工作表2").displaydata (s)
     
    Else
        MsgBox "請進行查詢後再執行更新"
    End If
End Sub
=============================
MutiPage元件:
標題1  標題2  標題3
(pages(0)  pages(1)  pages(2)

Mutipage1.pages(0).caption="標題"
Mutipage1.value=0     啟動時預設頁面

0919

sql = "delete from persondata where 編號='" + id + "'"

Private Sub CommandButton5_Click()
    Dim id, sql As String
 
 
    If TextBox6.Text <> "" Then
        id = TextBox1.Text
        sql = "delete from persondata where 編號='" + id + "'"
        modifydata (sql)
        MsgBox "已執行刪除"
    Else
        MsgBox "請進行查詢後再執行刪除"
    End If
 
End Sub

==================================
Public Function modifydata(ByVal sql As String)
    On Error GoTo Label2
     
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
 
    ConnectionString = "driver={mysql odbc 5.1 driver};database=persondb;server=127.0.0.1;port=3306;uid=root;password=12345678;opt=3;smt=SET NAMES 'gb2312'"
    conn.Open ConnectionString
 
    rs.Open sql, conn
 

    conn.Close
    Set rs = Nothing
    Set conn = Nothing
 
   
    Exit Function
Label2:
    MsgBox "此筆資料已存在"
    cleardata
End Function
==================================================

sql = "update persondata set 編號='" + id + "',姓名='" + name + "',血型='" + blood + "',學歷='" + school + "',職務='" + work + "' where 編號='" + id + "'"

where 編號='" + id + "'    為固定指標
=========================================
Private Sub CommandButton4_Click()
    Dim sql As String
    Dim id As String
    Dim name As String
    Dim blood As String
    Dim school As String
    Dim work As String
 
 
    If TextBox6.Text <> "" Then
     
        id = TextBox1.Text
        name = TextBox2.Text
        blood = TextBox3.Text
        school = TextBox4.Text
        work = TextBox5.Text
        sql = "update persondata set 編號='" + id + "',姓名='" + name + "',血型='" + blood + "',學歷='" + school + "',職務='" + work + "' where 編號='" + id + "'"
        modifydata (sql)
     
        Dim s As String
        s = "select * from persondata"
        Worksheets("工作表2").displaydata (s)
     
    Else
        MsgBox "請進行查詢後再執行更新"
    End If
End Sub
=============================
MutiPage元件:
標題1  標題2  標題3
(pages(0)  pages(1)  pages(2)

Mutipage1.pages(0).caption="標題"
Mutipage1.value=0     啟動時預設頁面