1019

ACE資料連線
 Dim myconn As New ADODB.Connection
    Dim myrs As New ADODB.Recordset
    Dim sql As String
 
    myconn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=E:\20160905\VBAproject\hope01.xlsx;Extended Properties=Excel 12.0;"
    myconn.CommandTimeout = 40
    myconn.Open
    sql = "select * from [工作表1$]"
    myrs.Open sql, myconn
 
    MsgBox "excel 檔案已找到"
 
    myrs.Close
    myconn.Close
    Set myrs = Nothing
    Set myconn = Nothing
==================================
Private Sub CommandButton1_Click()
    Dim sql, last As String
    sql = "select * from "
    last = ""
    Call browserdata(sql, 1, 4, last)
End Sub
===================================
Public Sub browserdata(ByVal sql, f4, t2, fin As String)
On Error Resume Next
    Dim myconn As New ADODB.Connection
    Dim myrs As New ADODB.Recordset
    myconn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\appserv\chin1.xlsx;Extended Properties=Excel 12.0;"
    myconn.ConnectionTimeout = 40
    myconn.Open
 
    Cells.Clear
    Cells(1, 1) = "編號"
    Cells(1, 2) = "姓名"
    Cells(1, 3) = "生日"
    Cells(1, 4) = "血型"
    Cells(1, 5) = "學歷"
    Dim sqr As String
    Dim i As Integer
    For i = CInt(f4) To CInt(t2) Step 1
        sqr = sql & "[工作表" & i & "$]" & fin
'        MsgBox sqr
        myrs.Open sqr, myconn
'        MsgBox "工作表資料讀出"
        If (myrs.Fields.Count > 1) Then
'            MsgBox myrs.Fields.Count
            myrs.MoveFirst
            Do While Not myrs.EOF
                Cells(Rows.Count, 1).End(xlUp).Select
                path = Selection.Address
                Range(path).Offset(1, 0).Value = myrs("編號")
                Range(path).Offset(1, 1).Value = myrs("姓名")
                Range(path).Offset(1, 2).Value = DateValue(myrs("生日"))
                Range(path).Offset(1, 3).Value = myrs("血型")
                Range(path).Offset(1, 4).Value = myrs("學歷")
                myrs.MoveNext
            Loop
        End If
        myrs.Close
    Next
 
    myconn.Close
    Set myrs = Nothing
    Set myconn = Nothing
End Sub

Private Sub CommandButton2_Click()
    UserForm7.Show
End Sub

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

Private Sub CommandButton1_Click()

    Dim id, sql, last As String

    id = TextBox1.Text

    sql = "select * from "

    last = " where 編號 = '" & id & "'"

    Call Sheets(7).browserdata(sql, 1, 4, last)

End Sub

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

Private Sub CommandButton2_Click()

    Dim sql, last As String

    sql = "select * from "

    last = ""

    Call Sheets(7).browserdata(sql, 1, 4, last)

    MsgBox ActiveWorkbook.Worksheets.Count

End Sub

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

     

1014 從檔案及listbox找出資料並送出列印

Private Sub CommandButton13_Click()
 On Error Resume Next
    Dim sbt As String
 
    sbt = CommandButton13.Caption
    If sbt = "報表4" Then
 
        Set shreport = Worksheets("report")
         
        If shreport Is Nothing Then
            Sheets.Add After:=Sheets(Sheets.Count)   '加在最後面
            Sheets(Sheets.Count).name = "report"
            ActiveWindow.DisplayGridlines = False  '格線取消
         
            '資料輸出從檔案
            Dim con5 As New Ani5
            Dim sql As String
            sql = "select * from scoredata"
            
            Dim kdata
            kdata = con5.dataload(sql, "persondb", "12345678")
         
            Dim listr As Integer
            Dim j As Integer
            listr = UBound(kdata, 1)
            For j = 0 To listr - 1 Step 1
                Cells(j + 1, 1).Value = kdata(j, 0)
                Cells(j + 1, 2).Value = kdata(j, 1)
                Cells(j + 1, 3).Value = kdata(j, 2)
                Cells(j + 1, 4).Value = kdata(j, 3)
                Cells(j + 1, 5).Value = kdata(j, 4)
                Cells(j + 1, 6).Value = kdata(j, 5)
            Next j
            '資料輸出
            UserForm5.Hide
         
            '列印設定
            With ActiveSheet.PageSetup
                .LeftHeader = "&12&""標楷體""北訊電腦資訊中心" '設自型大小 自型 及標題
                .CenterHeader = "成績資料表"
                .RightHeader = "列印日" & "&D"
            End With
         
            With PageSetup
                .LeftFooter = ""
                .CenterFooter = "&p/&n"
                .RightFooter = ""
            End With
         
            Worksheets("report").PrintPreview
            '列印設定
         
            UserForm5.Show vbModeless
         
         
         
        End If
        CommandButton13.Caption = "關閉"
    Else
        'MsgBox "此報表已經存在"
        Application.DisplayAlerts = False
        Sheets("report").Delete
        CommandButton13.Caption = "報表4"
    End If
End Sub
=============================================
Private Sub CommandButton14_Click()
    On Error Resume Next
    Dim sbt As String
 
    sbt = CommandButton14.Caption
    If sbt = "列印輸出" Then
 
        Set shreport = Worksheets("report")
         
        If shreport Is Nothing Then
            Sheets.Add After:=Sheets(Sheets.Count)   '加在最後面
            Sheets(Sheets.Count).name = "report"
            ActiveWindow.DisplayGridlines = False  '格線取消
         
            '資料輸出從listbox
         
            Dim listr As Integer
            Dim j As Integer
            listr = ListBox1.ListCount
            'MsgBox listr
            For j = 0 To listr - 1 Step 1
                Cells(j + 1, 1).Value = ListBox1.List(j, 0)
                Cells(j + 1, 2).Value = ListBox1.List(j, 1)
                Cells(j + 1, 3).Value = ListBox1.List(j, 2)
                Cells(j + 1, 4).Value = ListBox1.List(j, 3)
                Cells(j + 1, 5).Value = ListBox1.List(j, 4)
                Cells(j + 1, 6).Value = ListBox1.List(j, 5)
            Next j
            '資料輸出
            UserForm5.Hide
         
            '列印設定
            With ActiveSheet.PageSetup
                .LeftHeader = "北訊電腦資訊中心"
                .CenterHeader = "成績資料表"
                .RightHeader = "列印日" & "&D"
            End With
         
            With PageSetup
                .LeftFooter = ""
                .CenterFooter = "&p/&n"
                .RightFooter = ""
            End With
         
            Worksheets("report").PrintPreview  '預覽列印
            '列印設定
         
            UserForm5.Show vbModeless
         
         
         
        End If
        CommandButton14.Caption = "關閉"
    Else
        'MsgBox "此報表已經存在"
        Application.DisplayAlerts = False
        Sheets("report").Delete
        CommandButton14.Caption = "列印輸出"
    End If
End Sub
======================
超連結：
1.加入超連結
   Hyperlinks.add  來源資料,目標連結
2.刪除超連結
Hyperlinks.delete
==================================
Private Sub CommandButton1_Click()
    Hyperlinks.Add Cells(1, 1), "http://www.yahoo.com.tw"
End Sub

Private Sub CommandButton2_Click()
    Hyperlinks.Delete
End Sub

Private Sub CommandButton3_Click()
    Dim rcount As Integer
    Dim i As Integer
   
    rcount = UsedRange.Rows.Count
    For i = 1 To rcount Step 1
        Hyperlinks.Add Cells(i, 1), "http://127.0.0.1:80/hope/"
    Next i
   
End Sub

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

Private Sub CommandButton4_Click()

    Dim cok1 As New Collection

    Dim cok2 As New Collection

    Dim rcount As Integer

    Dim i As Integer

    Dim j As Integer

        

    

    rcount = UsedRange.Rows.Count

    

    For i = 1 To rcount Step 1

        cok1.Add Cells(i, 1)

        cok2.Add Cells(i, 2)

    Next i

    For j = 1 To rcount Step 1

        Hyperlinks.Add Cells(j, 1), "http://127.0.0.1:80/hope/hope01.php?id=" & cok1.Item(j) & "&name=" & cok2.Item(j)

    Next j

End Sub

1012

動態報表查詢系統
1.編號查詢報表
2.姓名查詢報表
3.瀏覽資料報表
4.區間報表
5.日報表
6.月報表
7.季報表
                   sql                              VBA                            printSetup
主表單 ===========database=========報表種類===========列印

sql預存程序
CREATE DEFINER=`root`@`localhost` PROCEDURE `interdata`(IN `id1` VARCHAR(50), IN `id2` VARCHAR(50))
LANGUAGE SQL
NOT DETERMINISTIC
CONTAINS SQL
SQL SECURITY DEFINER
COMMENT ''
BEGIN
select * from scoredata where 學號 between id1 and id2;
END


   Private Sub CommandButton1_Click()
    Dim id1 As String
    Dim id2 As String
 
    If TextBox1.Text <> "" And TextBox2.Text <> "" Then
        id1 = TextBox1.Text
        id2 = TextBox2.Text
     
        sql = "call interdata('" & id1 & "','" & id2 & "')"
        Call UserForm5.loaddata(sql)           '跨表單呼叫
    Else
        MsgBox "請輸入完整資料"
    End If
 
End Sub
=======================================

Private Sub CommandButton10_Click()
On Error Resume Next
    'Dim ws As Worksheet
    'ws.name = "report"
    'Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
    Set shreport = Worksheets("report")
     
    If shreport Is Nothing Then
        Sheets.Add After:=Sheets(Sheets.Count)   '加在最後面
        Sheets(Sheets.Count).name = "report"
    Else
        MsgBox "此報表已經存在"
        Application.DisplayAlerts = False
        Sheets("report").Delete
    End If
End Sub    
===================================
 Private Sub CommandButton11_Click()
On Error Resume Next
    Dim sbt As String
 
    sbt = CommandButton11.Caption
    If sbt = "報表二" Then
 
        Set shreport = Worksheets("report")
         
        If shreport Is Nothing Then
            Sheets.Add After:=Sheets(Sheets.Count)   '加在最後面
            Sheets(Sheets.Count).name = "report"
        End If
        CommandButton11.Caption = "關閉"
    Else
        MsgBox "此報表已經存在"
        Application.DisplayAlerts = False
        Sheets("report").Delete
        CommandButton11.Caption = "報表二"
    End If

End Sub    
               

1007

ddata
CREATE DEFINER=`root`@`localhost` PROCEDURE `ddata`(IN `id` CHAR(50))
LANGUAGE SQL
NOT DETERMINISTIC
CONTAINS SQL
SQL SECURITY DEFINER
COMMENT ''
BEGIN
DELETE FROM scoredata WHERE 學號=id;
END

pname1
CREATE DEFINER=`root`@`localhost` PROCEDURE `pname1`(IN `name` VARCHAR(50))
LANGUAGE SQL
NOT DETERMINISTIC
CONTAINS SQL
SQL SECURITY DEFINER
COMMENT ''
BEGIN
Select * FROM scoredata Where 姓名 LIKE name;
END

udata
CREATE DEFINER=`root`@`localhost` PROCEDURE `udata`(IN `id` VARCHAR(50), IN `name` VARCHAR(50), IN `c1` INT, IN `c2` INT, IN `c3` INT, IN `c4` INT)
LANGUAGE SQL
NOT DETERMINISTIC
CONTAINS SQL
SQL SECURITY DEFINER
COMMENT ''
BEGIN
update scoredata set 姓名=name,國文=c1,英文=c2,數學=c3,地理=c4 where 學號=id;

=======================================================
Private Sub CommandButton6_Click()
    Dim lname As String
    Dim sql As String
   
    If TextBox9.Text <> "" Then
        lname = TextBox9.Text
        sql = "call pname1 ('%" & lname & "%')"
        Call loaddata(sql)
    Else
        MsgBox "請輸入資料"
    End If
End Sub
=============================================
Private Sub CommandButton7_Click()
    Dim com5 As New Ani5
    Dim did As String
    Dim sql As String
   
    If TextBox7.Text <> "" Then
        did = TextBox7.Text
        sql = "call ddata ('" & did & "')"
        com5.modifydata sql:=sql, dn:="persondb", pw:="12345678"
        Call loaddata("select * from dbview1")
    Else
        MsgBox "請先查詢輸入欲刪除資料學號"
    End If
End Sub
==================================================
CREATE PROCEDURE `interdata`(IN `id1` VARCHAR(50), IN `id2` VARCHAR(50))
LANGUAGE SQL
NOT DETERMINISTIC
CONTAINS SQL
SQL SECURITY DEFINER
COMMENT ''
BEGIN
select * from scoredata where 學號 between id1 and id2;
END

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     啟動時預設頁面

0926

TextBox1.Activate    工作表到焦點
TextBox1.setforcus     表單用

主系統   <==>類別元件
       ||
         === WebBrowser====AppServ-php====databbase

表單得工具箱=按右鍵=新增控制項=選Microsoft.WebBrowser=確定


表單上的按鈕
Private Sub CommandButton1_Click()
    On Error Resume Next
    WebBrowser1.Navigate2 ("http://www.google.com")
End Sub

ex:
 On Error Resume Next
    Dim url As String
 
    If TextBox1 <> "" Then
        url = TextBox1.Text
        WebBrowser1.Navigate2 (url)
    Else
        MsgBox "請輸入網址"
        TextBox1.SetFocus
   End If

WebBrowser1.Navigate2 ("http://192.168.1.26:80/hopechang/php01.php")

結合php

<!DOCTYPE html>

<html>

<body>

<?php

echo "My first PHP script!</BR>";

$con=@mysql_connect("localhost","root","12345678") or die("connect failed");

if(!@mysql_select_db("persondb",$con)) die("DB wanted failure");

mysql_query("set names utf8",$con);

$re=mysql_query("select * from persondata");

while ($tbl=mysql_fetch_array($re)){

print $tbl[0];print ",";

print $tbl[1];print ",";

print $tbl[2];print ",";

print $tbl[3];print ",";

print $tbl[4];print ",";

print "</BR>";

}

mysql_close($con);

?>

</body>

</html>

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

HeidiSQL_9.3 MySql資料庫介面用法

加主鍵

在#1 上按右鍵選創建新索引=primary
從excel匯出cvs檔，匯入資料庫
===================================
進階資料庫語言
1.視圖
2.預存程序
3.預存函數
4.觸發器
5.指標 存儲過程用
6.事件

使用視圖 select * from dbview1

dbview1類似匿名為保護資料庫

0923

一維參數
一維回傳
二維參數
二維回傳
集合參數
集合回傳

主系統 <===>webBrowser(元件) <=php系統==>AppServ < ===> database

一維參數
一維回傳
class  Ani3
Public Function fun1() As Integer()
    Dim a(2) As Integer
 
    a(0) = 14
    a(1) = 15
 
    fun1 = a
End Function

Private Sub CommandButton5_Click()

    Dim con3 As New Ani3

    

    Dim b   '由引數決定  

    

    b = con3.fun1

    MsgBox (Str(b(0)) + ":" + Str(b(1)))

End Sub

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

二維參數

Public Function fun2(b() As Integer)

    MsgBox (b(1, 0))

End Function

Private Sub CommandButton6_Click()

    Dim a(1, 1) As Integer

    

    a(0, 0) = 12

    a(0, 1) = 13

    a(1, 0) = 14

    a(1, 1) = 15

    

    Dim cin3 As New Ani3

    cin3.fun2 a

    

End Sub

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

二維回傳

Public Function fun3() As String()

    Dim a(1, 1) As String

    

    a(0, 0) = "bill"

    a(0, 1) = "lisa"

    a(1, 0) = "vovo"

    a(1, 1) = "dodo"

    fun3 = a

    

End Function

Private Sub CommandButton7_Click()

    Dim cin3 As New Ani3

    

    Dim b

    

    b = cin3.fun3

    MsgBox (b(1, 1))

    

End Sub

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

集合元件  Collection

Dim 元件 as New Collection

元件.Add String

set 函數名稱 = 元件

回傳

D變數  Collectuon

set 變數 = 類別元件‧函數

變數‧Item(項目索引值)

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

集合回傳

Private Sub CommandButton8_Click()

    Dim cin3 As New Ani3

    Dim b As Collection   '在類別中決定為集合，不須再new

    Set b = cin3.fun4

    MsgBox b.Item(2)

End Sub

Public Function fun4() As Collection

    Dim a As New Collection

     a.Add "bill"

     a.Add "lisa"

     Set fun4 = a

End Function

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

集合參數回傳

Public Function fun5(a As Collection)

    MsgBox a.Item(2)

End Function

Private Sub CommandButton9_Click()

    Dim cin3 As New Ani3

    Dim a As New Collection

    a.Add "bill"

    a.Add "lisa"

    cin3.fun5 a

End Sub

====================================
呼叫函數；無參數無回傳值
                    無參數有回傳值
                    有參數無回傳值
                    有參數有回傳值
 

當參數或回傳值
1.純變數
2.一維陣列
3.二維陣列
4.元件
=============================
ex:

Private Sub CommandButton10_Click()
    Dim qcon As New Qain4
    Dim rq    '由物件決定
    Dim sql As String
    Dim idquery As String
 

    TextBox2.Text = ""
    TextBox3.Text = ""
    TextBox4.Text = ""
    TextBox5.Text = ""
    TextBox1.SetFocus
 
    If TextBox1 <> "" Then
        On Error GoTo Label1
     
     
        idquery = TextBox1.Text
        sql = "select * from persondata where 編號='" + idquery + "'"
        rq = qcon.qfun1(sql)     '傳字串參數
        TextBox2.Text = rq(1)
        TextBox3.Text = rq(2)
        TextBox4.Text = rq(3)
        TextBox5.Text = rq(4)
        Exit Sub
Label1:
    MsgBox "查無此筆資料"
    TextBox1 = ""
    TextBox1.SetFocus
    Else
        MsgBox "請輸入資料"
        TextBox1.SetFocus
   End If
 
End Sub

Private Sub CommandButton2_Click()
    Dim com1 As New Ani1
    com1.fun2 a:=12, b:=45
End Sub

Private Sub CommandButton3_Click()
    Dim com1 As New Ani1
    Dim i As Integer
 
    i = com1.fun3
    MsgBox i
End Sub
==============================
Public Function qfun1(ByVal q As String) As String()
    Dim data(5) As String
    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 q, conn
         
    rs.MoveFirst
    Do While Not rs.EOF
       data(0) = rs("編號")
       data(1) = rs("姓名")
       data(2) = rs("血型")
       data(3) = rs("學歷")
       data(4) = rs("職務")
   
     rs.MoveNext
    Loop
       rs.Close
       conn.Close
     
       qfun1 = data
     
End Function

0921

類別元件屋
函數第三架構
public function 函數名稱() as 資料型態
      [程式區塊]
      函數名稱=回傳變數(值)
end function

函數第四 架構
public function 函數名稱(byval a as Integer,byval b as Integer) as 資料型態
      [程式區塊]
      函數名稱=回傳變數(值)
end function


物件類別模組   ==從插入建立
Public Function fun1()
    MsgBox "函數架構之區塊"
End Function
Public Function fun2(ByVal a As Integer, ByVal b As Integer)
    MsgBox a + b
End Function

Public Function fun3() As Integer
    fun3 = 555
End Function

Public Function fun4(ByVal x As Integer, ByVal y As Integer) As Integer
    Dim total As Integer
 
    total = x + y
    fun4 = total
End Function


=================================================
呼叫 類別元件
Private Sub CommandButton1_Click()
   Dim com1 As New Ani1   建立實體元件
   com1.fun1
End Sub

Private Sub CommandButton2_Click()
    Dim com1 As New Ani1
    com1.fun2 a:=12, b:=45     有別於一般用法 com1.fun2(a,b)
End Sub

Private Sub CommandButton3_Click()
    Dim com1 As New Ani1
    Dim i As Integer
 
    i = com1.fun3
    MsgBox i
End Sub

Private Sub CommandButton4_Click()
    Dim com1 As New Ani1
    Dim sum As Integer
 
    sum = com1.fun4(22, 55)
    MsgBox sum
End Sub

http://www.cpearson.com/excel/classes.aspx

陣列
http://www.globaliconnect.com/excel/index.php?option=com_content&view=article&id=161:excel-vba-passing-arguments-to-procedures-parameter-arrays-paramarray&catid=79&Itemid=475
多重頁面

'use the With ... End With statement to refer to a Range object
With Worksheets("Sheet1").Range("A1")

'use the Value property of the Range object, to set the value for the range:
.Value = 11
'use the Name property, of the Range object, to set the range name:
.Name = "Score"

'use the Font Property of the Range object that returns a Font object, and then use the With ... End With statement to refer to the Font object
With .Font

'note that because you are using the With ... End With statement to refer to the Font object within the Range object, you will not refer to both the range or font objects below:
'use the Name property of the Font object to set the font name:
.Name = "Arial"
'use the Bold property of the Font object to set the font to bold:
.Bold = True
'use the Color property of the Font object to set the font color:

.Color = vbRed

End With

'use the Borders property of the Range object to return all four borders (Borders collection object), and then use the LineStyle property of the Borders object to add a double border:
.Borders.LineStyle = xlDouble

'the Clear Method of the Range object, clears the range (clears the contents, formulas and formatting):

.Clear

End With

Excel Objects Hierarchy

Application Object

Workbook Object

Worksheet Object

Range Object

0909

 讀取最後一筆資料
   Dim lastid As String
    lastid = Cells(Rows.Count, 1).End(xlUp).Value
    MsgBox lastid


查詢
ㄧ
布局基本架構
Private Sub CommandButton6_Click()
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sql As String
    Dim path As String
    Dim idquery As String
 
    If TextBox1.Text <> "" Then
        Call cleardata
 
 
 
    Else
        MsgBox "請輸入資料"
   End If
 
End Sub
===========================
布局例外
Private Sub CommandButton6_Click()
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sql As String
    Dim path As String
    Dim idquery As String
 
    If TextBox1.Text <> "" Then
        On Error GoTo Label1
        Call cleardata
 
 Label1:
    MsgBox "查無此筆資料"
    Call browserdata
    Else
        MsgBox "請輸入資料"
   End If
 
End Sub

=========================
Private Sub CommandButton6_Click()
    Dim conn As New ADODB.Connection  '資料庫連線
    Dim rs As New ADODB.Recordset     '資料集
    Dim sql As String                 '資料庫語言
    Dim path As String                '位址變數
    Dim idquery As String             '資料來源框查詢變數
 
    If TextBox1.Text <> "" Then
        On Error GoTo Label1
        Call cleardata
     
        idquery = TextBox1.Text
        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
        sql = "select * from persondata where 編號='" + idquery + "'"
        rs.Open sql, conn
 
       rs.MoveFirst
       Do While Not rs.EOF
          Cells(Rows.Count, 1).End(xlUp).Select
          path = Selection.Address
          Range(path).Offset(1, 0).Value = rs("編號")
          Range(path).Offset(1, 1).Value = rs("姓名")
          Range(path).Offset(1, 2).Value = rs("血型")
          Range(path).Offset(1, 3).Value = rs("學歷")
          Range(path).Offset(1, 4).Value = rs("職務")
          rs.MoveNext
       Loop
 
       rs.Close
       conn.Close
       Exit Sub    '跳出結束
 
Label1:
    MsgBox "查無此筆資料"
    Call browserdata
 
    Else
        MsgBox "請輸入資料"
   End If
 
End Sub
============================

Public Sub browserdata()
    Call cleardata
    Sheets(1).Cells(1, 1).Value = "編號"
    Sheets(1).Cells(1, 2).Value = "姓名"
    Sheets(1).Cells(1, 3).Value = "血型"
    Sheets(1).Cells(1, 4).Value = "學歷"
    Sheets(1).Cells(1, 5).Value = "職務"
 
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sql As String
    Dim path As String

    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
    sql = "select * from persondata"
    rs.Open sql, conn
 
    rs.MoveFirst
    Do While Not rs.EOF
       Cells(Rows.Count, 1).End(xlUp).Select
       path = Selection.Address
       Range(path).Offset(1, 0).Value = rs("編號")
       Range(path).Offset(1, 1).Value = rs("姓名")
       Range(path).Offset(1, 2).Value = rs("血型")
       Range(path).Offset(1, 3).Value = rs("學歷")
       Range(path).Offset(1, 4).Value = rs("職務")
       rs.MoveNext
 Loop

 rs.Close
 conn.Close
 
 
End Sub

0909

 讀取最後一筆資料
   Dim lastid As String
    lastid = Cells(Rows.Count, 1).End(xlUp).Value
    MsgBox lastid


查詢
ㄧ

Private Sub CommandButton6_Click()
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sql As String
    Dim path As String
    Dim idquery As String
 
    If TextBox1.Text <> "" Then
        Call cleardata
 
 
 
    Else
        MsgBox "請輸入資料"
   End If
 
End Sub
===========================
Private Sub CommandButton6_Click()
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sql As String
    Dim path As String
    Dim idquery As String
 
    If TextBox1.Text <> "" Then
        On Error GoTo Label1
        Call cleardata
 
 Label1:
    MsgBox "查無此筆資料"
    Call browserdata
    Else
        MsgBox "請輸入資料"
   End If
 
End Sub

=========================
Private Sub CommandButton6_Click()
    Dim conn As New ADODB.Connection  '資料庫連線
    Dim rs As New ADODB.Recordset     '資料集
    Dim sql As String                 '資料庫語言
    Dim path As String                '位址變數
    Dim idquery As String             '資料來源框查詢變數
 
    If TextBox1.Text <> "" Then
        On Error GoTo Label1
        Call cleardata
     
        idquery = TextBox1.Text
        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
        sql = "select * from persondata where 編號='" + idquery + "'"
        rs.Open sql, conn
 
       rs.MoveFirst
       Do While Not rs.EOF
          Cells(Rows.Count, 1).End(xlUp).Select
          path = Selection.Address
          Range(path).Offset(1, 0).Value = rs("編號")
          Range(path).Offset(1, 1).Value = rs("姓名")
          Range(path).Offset(1, 2).Value = rs("血型")
          Range(path).Offset(1, 3).Value = rs("學歷")
          Range(path).Offset(1, 4).Value = rs("職務")
          rs.MoveNext
       Loop
 
       rs.Close
       conn.Close
       Exit Sub
 
Label1:
    MsgBox "查無此筆資料"
    Call browserdata
 
    Else
        MsgBox "請輸入資料"
   End If
 
End Sub
============================

Public Sub browserdata()
    Call cleardata
    Sheets(1).Cells(1, 1).Value = "編號"
    Sheets(1).Cells(1, 2).Value = "姓名"
    Sheets(1).Cells(1, 3).Value = "血型"
    Sheets(1).Cells(1, 4).Value = "學歷"
    Sheets(1).Cells(1, 5).Value = "職務"
   
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sql As String
    Dim path As String

    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
    sql = "select * from persondata"
    rs.Open sql, conn
   
    rs.MoveFirst
    Do While Not rs.EOF
       Cells(Rows.Count, 1).End(xlUp).Select
       path = Selection.Address
       Range(path).Offset(1, 0).Value = rs("編號")
       Range(path).Offset(1, 1).Value = rs("姓名")
       Range(path).Offset(1, 2).Value = rs("血型")
       Range(path).Offset(1, 3).Value = rs("學歷")
       Range(path).Offset(1, 4).Value = rs("職務")
       rs.MoveNext
 Loop

 rs.Close
 conn.Close
   
   
End Sub

0907 vba

ADODB.Connection  元件
宣告：Dim 元件變數   as new  ADODB.Connection
使用：Dim conn As New ADODB.Connection
 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

ADODB.Recordset:   資料集
宣告：Dim 元件變數   as new  ADODB.Recordset
使用：Dim rs As New ADODB.Recordset
           rs.Open sql, conn 


SQL 語言    資料表 persondata
Dim sql As String
ql = "select * from persondata"

例子

宣告元素後ˋ，先布局 conn sql，再open 資料集，用完結束，先關資料集，再關連線裝置
由外到內，由大架構到小架構
資料庫=>連線裝置=>資料集=>資料庫操作函數=>Excel VBA應用程式

Private Sub CommandButton2_Click()

Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String

 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
 sql = "select * from persondata"
 rs.Open sql, conn
 MsgBox " mysql資料表打開 "

 rs.Close
 conn.Close

End Sub

資料庫操作函數
元件.BOF
元件.EOF
元件.MoveFirst()
元件.MoveLast()
元件.MoveNext()
元件.MovePrevioous()
用do while not rs.EOF()
     ... rs("編號")
     ... rs("姓名")
     ... rs("血型") 
     ... rs("學歷")
     ... rs("職務")
    loop

例子
Private Sub CommandButton3_Click()
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String

 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
 sql = "select * from persondata"
 rs.Open sql, conn

 rs.MoveFirst
 Do While Not rs.EOF
    MsgBox rs("姓名")
    rs.MoveNext
 Loop

 rs.Close
 conn.Close
End Sub



Excel VBA應用程式
1.找到有效位址  Cells(Rows.Count, 1).End(xlUp).Select
2.取得有效位置的絕對位置  path = Selection.Address
3.偏移植 填入欄位值
       Range(path).Offset(1, 0).Value = rs("編號")
       Range(path).Offset(1, 1).Value = rs("姓名")
       Range(path).Offset(1, 2).Value = rs("血型")
       Range(path).Offset(1, 3).Value = rs("學歷")
       Range(path).Offset(1, 4).Value = rs("職務")
4.移下一筆資料表指標
Private Sub CommandButton4_Click()
    Call cleardata
    Sheets(1).Cells(1, 1).Value = "編號"
    Sheets(1).Cells(1, 2).Value = "姓名"
    Sheets(1).Cells(1, 3).Value = "血型"
    Sheets(1).Cells(1, 4).Value = "學歷"
    Sheets(1).Cells(1, 5).Value = "職務"
   
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sql As String
    Dim path As String

    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
    sql = "select * from persondata"
    rs.Open sql, conn
   
    rs.MoveFirst
    Do While Not rs.EOF
       Cells(Rows.Count, 1).End(xlUp).Select
       path = Selection.Address
       Range(path).Offset(1, 0).Value = rs("編號")
       Range(path).Offset(1, 1).Value = rs("姓名")
       Range(path).Offset(1, 2).Value = rs("血型")
       Range(path).Offset(1, 3).Value = rs("學歷")
       Range(path).Offset(1, 4).Value = rs("職務")
       rs.MoveNext
 Loop

 rs.Close
 conn.Close
   
   
End Sub
Public Sub cleardata()
    Dim rcount As Integer
    rcount = Sheets(1).UsedRange.Rows.Count
    Range("A2:E" & rcount).ClearContents
End Sub