搜尋一下都是一些複雜的方式
其實很簡單,vba本來就有這個功能,只要用Controls.Add,就可輕易做到
在其它副程式中設定屬性、取出、寫入資料,只需改用UserForm1.Controls()就可簡單處理
'===================================================
'前置作業
'一、建立一個工作表1
'二、建立一個userform1
'三、建立一個commandbutton1
'四、把程式碼放到commandbutton1
'五、在工作表1(a欄),填入任意數量的文字、儲存格
Private Sub CommandButton1_Click()
Dim CheckBox_Array() As Control, i As Integer, MoveTop As Integer, Lastrow As Integer
'設定要建立幾個控制項
Lastrow = Sheets("工作表1").Range("a1").CurrentRegion.Rows.Count
ReDim CheckBox_Array(1 To Lastrow)
MoveTop = 0
For i = 1 To Lastrow
'建立控制項,"Forms.CheckBox.1" =>名稱固定, ("CheckBox" & i)=>可自訂
Set CheckBox_Array(i) = Controls.Add("Forms.CheckBox.1", "CheckBox" & i)
'調整位置
CheckBox_Array(i).Top = MoveTop + 15
CheckBox_Array(i).Left = 50
'把儲存格內容放入控制項
CheckBox_Array(i).Caption = Sheets("工作表1").Cells(i, 1)
MoveTop = MoveTop + 15
Next i
End Sub
'===================================================
改成textbox(或其它控制項),把其中2行,換成下面這樣,
'Set CheckBox_Array(i) = Controls.Add("Forms.textbox.1", "textbox" & i)
'CheckBox_Array(i).Text = Sheets("工作表1").Cells(i, 1)
改成commandbutton(或其它控制項),只需改一行
Set CheckBox_Array(i) = Controls.Add("Forms.commandbutton.1", "commandbutton" & i)
改成label(或其它控制項),只需改一行
Set CheckBox_Array(i) = Controls.Add("Forms.label.1", "label" & i)
'===================================================
'因為是程式產生的控制項
'如果要在其它的副程式中取出由程式產生的控制項內容、屬性…等等,就要改成這種寫法
'沒辦法用msgbox textbox1.text.... 這種簡單的寫法
'多建立一個commandbutton2,自行練習
Private Sub CommandButton2_Click()
MsgBox UserForm1.Controls("checkbox1")
MsgBox UserForm1.Controls("checkbox2")
'MsgBox UserForm1.Controls("textbox3").text
End Sub
'或是也可以自行把CheckBox_Array(),改成全域變數
'這樣就可以在所有的副程式用這種方式msgbox CheckBox_Array(2)讀取(或寫入)資料
'===================================================
其它控制項,請自行練習
Sub 買賣超佔成交量()
Dim t: t = Timer
Dim URL
Dim myXML As Object
Set myXML = CreateObject("Microsoft.XMLHTTP")
Dim myHTML As Object
Set myHTML = CreateObject("HTMLFile")
Dim Clipboard As Object
Set Clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
URL = "https://goodinfo.tw/StockInfo/ShowBuySaleChart.asp?STOCK_ID=3491&CHT_CAT=DATE&Sheet=買賣超佔成交量&PERIOD=180"
With myXML
.Open "GET", URL, False
.send
myHTML.body.innerhtml = .responsetext
End With
Set myTable = myHTML.getElementsByTagName("table")(19)
Cells.ClearContents
With Clipboard
.SetText myTable.outerHTML
.PutInClipboard
End With
[A3].Select
Sheets("工作表1").PasteSpecial NoHTMLFormatting:=False
Set Clipboard = Nothing
Set myXML = Nothing
Set myHTML = Nothing
Debug.Print Format(Timer - t, "0.00秒")
End Sub
alantsai5840 wrote:
要抓三法人六個月買賣超佔成交量 結果多抓到三個月買賣超 一直找不到原因 ...(恕刪)
主要錯誤有3個
一、需用 post
二、省略太多 setRequestHeader
三、少一個Referer網址
提示一:
URL = "https://goodinfo.tw/StockInfo/ShowBuySaleChart.asp?STOCK_ID=2002&CHT_CAT=DATE&SHEET=買賣超佔成交量&STEP=DATA&PERIOD=180"
URL_a = "https://goodinfo.tw/StockInfo/ShowBuySaleChart.asp?STOCK_ID=2002&CHT_CAT=DATE&Sheet=買賣超佔成交量&PERIOD=180"
提示二:
Set Table = HTMLsourcecode.getelementbyid("divBuySaleDetail")
請參考294樓,先試著自己寫看看
alantsai5840 wrote:
[A3].Select...(恕刪)
您大概常看麻辣那邊的文章吧?
建議,儘量改掉用[]的習慣,有太多工作表時容易出錯,而且影響速度
原因請看這一篇
https://www.mobile01.com/topicdetail.php?f=511&t=5328464
shing2417 wrote:
我之前用winxp sp3 + ie8 + chrome + excel 2010
就無法通過 .send (接收消息異常)
連ie8 都打唔開個網頁...(恕刪)
那是因為xp 不支援使用新版 https 連線加密網站的原因
所以在xp中,使用xmlhttp vba去存取 https(新版tls)的網址時
就會在.send 時出現錯誤,跟excel版本無關,是xp先天限制
(沒想到還有人在用xp,跑這個vba程式碼)
雖然正常的方式無法處理,但還是有解決方法
因為微軟其實有更新檔可用,只是不開放給xp
是用在xp pos系統,但是可以透過一點小修改,就可安裝在xp
一、去微軟官方網站,xp 請改用firefox or chrome or 其它xp以上電腦,ie8可能無法下載
KB4019276 (TLS 1.1/1.2 support)
http://www.catalog.update.microsoft.com/Search.aspx?q=KB4019276
先選
再選第一個下載
二、建立一個登錄檔tls.reg
===================(分隔文章用,不含等號)
Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\SYSTEM\WPA\PosReady]
"Installed"=dword:00000001
===================(分隔文章用,不含等號)
三、在xp中執行tls.reg
四、安裝下載的檔案,重開機,程式不用任何修改就可正常執行
關閉廣告