excel vba note: 9月 2016

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

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
============================

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

訂閱：文章 (Atom)

2016年9月30日 星期五

2016年9月26日 星期一

2016年9月23日 星期五

2016年9月21日 星期三

2016年9月9日 星期五

2016年9月7日 星期三

2016年9月5日 星期一

2016年9月30日星期五

2016年9月26日星期一

2016年9月23日星期五

2016年9月21日星期三

2016年9月9日星期五

2016年9月7日星期三

2016年9月5日星期一