2016年9月30日 星期五

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

2016年9月26日 星期一

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類似匿名為保護資料庫



2016年9月23日 星期五

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

2016年9月21日 星期三

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

2016年9月9日 星期五

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

2016年9月7日 星期三

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





2016年9月5日 星期一

excelvbba 0905 data

vba0720@gmail.com
excelvba
oracle  hope450615@gmail.com  Hope1234

excel2010--bva應用程式
                -

ExcelVBA Connection    Driver  connection Odbc
 sql 語言  1.查詢系統
                 2.新增
                 3.刪除
                 4.刪修
                5..預存程序
                6..預存函數

webserver網頁伺服器appserv v8     appserver  wamp server  port 80

database 資料庫        mysql server  mssql server  port 3306

HeidiSGL  資料庫管理介面



安裝
1.appserv-win32-8.4.0
  password   12345678
 code  utf-8 unicode

google 127.0.0.1:80
     php myadmin
   usename  root
   password 12345678
命令提示字元>ipconfig

2.Heidisql=>新建        root    12345678
3.odbc 5.1.13
4.建VBAproject  資料夾
   新建excel 檔->啟用巨集
   save hopedb1
   active  microsoft Active 2.8=>3個    啟用Visul Basic

DB
1.建立資料庫



Private Sub CommandButton1_Click()
 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

MsgBox "連接 mysql server"
conn.Close
End Sub