excel vba 操作相關物件引用

1，使用adodb.stream物件提取字串

function bytestobstr(strbody, codebase)         '

使用adodb.stream物件提取字串
dimobjstream
onerror
resume
next
set objstream = createobject("
adodb.stream")
with
objstream
.type = 1
'二進位制
.mode = 3'讀寫
.open
.write strbody 
'二進位制陣列寫入adodb.stream物件內部
.position = 0
'位置起始為0
.type = 2
'字串
.charset = codebase '
資料的編碼格式
bytestobstr = .readtext '
得到字串
endwith
objstream.close
set objstream = nothing
if err.number <> 0
then bytestobstr = ""
onerror
goto
0end function

2，使用正規表示式匹配responsetext中 sessionid=數字 的內容

sub

reg_sessionid()
set reg = createobject("
vbscript.regexp")
with
reg .global = true
.ignorecase = true
.pattern = "
&sessionid=\d
"end
with
set mc =reg.execute(responsetext)
sessionid = split(mc(0).value, "
=")(1
) 
'物件引用完成後需要置空
set reg = nothing
set mc = nothing
end sub

3，使用adodb鏈結資料庫

sub

returnsqlrecord()
'sht 為excel工作表物件變數,指向某一工作表
dim i&, sht as
worksheet
'定義資料鏈結物件 ，儲存連線資料庫資訊
'使用adodb，須在選單的tools->references中新增引用「microsoft activex data objects library 2.x」
'dim cn as new adodb.connection
'定義記錄集物件，儲存資料表
'dim rs as new adodb.recordset
dim strcn as
string, strsql as
string
set cn = createobject("
adodb.connection")
set rs = createobject("
adodb.recordset")
'定義資料庫鏈結字串,server=伺服器名稱或ip位址(本地可填寫「.」);database=資料庫名稱;uid=使用者登入名;pwd=密碼
strcn = "
provider=sqloledb;server=.;database=train1;uid=sa;pwd=123;"'
定義sql查詢命令字串
strsql = "
select name,user from dbo.[test] "'
與資料庫建立連線，如果成功，返回連線物件cn
cn.open strcn
'執行strsql所含的sql命令，結果儲存在rs記錄集物件中
rs.open strsql, cn
i = 1
'把sht指向當前工作簿的sheet1工作表
set sht = thisworkbook.worksheets("
資料查詢區")
sht.range("a1
").copyfromrecordset rs
'當資料指標未移到記錄集末尾時，迴圈下列操作
'do while not rs.eof''
'把當前記錄的job_id欄位的值儲存到sheet1工作表的第i行第1列
'sht.cells(i, 1) = rs("name")
'sht.cells(i, 2) = rs("user")''
'把指標移向下一條記錄
'rs.movenext
'i = i + 1
'loop
'關閉記錄集
rs.close
'關閉資料庫鏈結,釋放資源
cn.close
end sub

4，建立乙個html物件，將responsetxt 中的資料複製到單元格』

sub

html取數()
set odoc = createobject("
htmlfile")
odoc.body.innerhtml =responsetext
'set mydata = createobject("new:")
'with mydata 'dataobject物件，資料放入剪貼簿，記事本觀察資料
'.settext responsetext
'.putinclipboard
'end with
onerror
resume
next
thisworkbook.sheets(
3).usedrange.numberformatlocal = "
g/通用格式
"if pn = 1
then
thisworkbook.sheets(
3).usedrange.delete xlup '
clearcontents
else
endif
cou = odoc.all.tags("
table
").length
with thisworkbook.sheets(3
) 
set r = odoc.all.tags("
table
")(0
).rows
lastrow = .range("
a65536
").end(3
).row
for i = 0
to r.length - 1
for j = 0
to r(i).cells.length - 1
.cells(i + 1 + lastrow, j + 1) =r(i).cells(j).innertext
next
next
endwith
end sub

5，json格式單詞解析

sub

figjson3()
aa = "}"
set x = createobject("
scriptcontrol")
x.language = "
jscript
"s = "
function j(s) 
"x.addcode s
set y = x.run("j"
, aa)
msgbox
y.myname
msgbox
y.myaddress
msgbox
y.myaddress.city
msgbox
y.myaddress.postcode
end sub

6，將列表中的元素一次性寫入單元格

sub

jsontorng() 
'json 直寫 range
dimsjson$, js$
sjson = [ "
, , , , ]
"js = "
var r,k,row=c=1,d={};for(r in j)rng(row,d[k])= j[r][k];}}
"js = "
j=" & sjson & "
;" &js
with
createobject("
scriptcontrol")
.language = "
jscript
".addobject 
"rng
", cells(3, "
a") '
a3 是起始單元格，可以改為別的單元格
.eval (js)
endwith
end sub

excel VBA 簡單操作

public sub ss dim sht as worksheet set sht thisworkbook.worksheets sheet1 sht.cells 1,1 now end sub public sub getrow dim rnum as integer dim sht as w...

Excel VBA 獲取按鈕物件

今天給同事寫了兩個vba巨集，並分別把巨集賦給了兩個按鈕。因為兩個巨集都是實現在兩種顯示方式之間切換，於是我想除了功能的實現外，還希望在切換到其中一種方式時，按鈕上面的文字也可以跟著改變，起到提示作用。但是網上找了很多文章，都實現不了，而且很多都是針對form表單控制項的。所以自己嘗試解決 先說明，...

Excel VBA檔案操作1

在我們日常使用excel的時候，不僅會用到當前excel檔案的資料，還經常需要訪問其他的資料檔案。這些資料檔案可能是excel檔案 文字檔案或資料庫檔案等。經常有朋友會問如何在vba 裡操作這些資料檔案？本文就系統地介紹一下在excel中應用vba運算元據檔案的方法。1 利用excel物件來處理檔案...