GBKEE

回復 10# wufonna

你的附檔
插入的圖片需使用繪圖的圖片
一樣你的附檔 的圖片沒改名稱為 "驗證圖"
給你除錯程式碼

1. Private Sub 圖形更新()
   
2.    On Error GoTo ER
   
3.     If IE Is Nothing Then Get_Ie
   
4.     If Msg Then MsgBox "驗證圖 更新完畢"
   
5.     Msg = False
   
6.     With IE
   
7.         .Refresh
   
8.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
   
9.         網路圖片存檔 .Document.ALL.tags("IMG")(0).href
   
10.     End With
    
11.     MsgBox 工作表1.Shapes("驗證圖").Name
    
12.    
    
13.     工作表1.Shapes("驗證圖").Fill.UserPicture 圖形    '
    
14.   Exit Sub
    
15. ER:
    
16.     MsgBox Err & vbLf & Err.Description
    
17.     Stop
    
18.     MsgBox 工作表1.Shapes(1).Name
    
19.     Resume
    
20. End Sub
    
21. 
    

複製代碼

wufonna

回復 11# GBKEE
GBKEE 大大
2010版的找不到圖片如何更名，
這程式是要先看圖片的字再輸入 F2 和 f4 才可輸出嗎
程式還不清楚，研究看看 不會再請教 大大
謝謝  GBKEE 版大

wufonna

回復 11# GBKEE

謝謝 GBKEE 大大
* 使用繪圖的圖片
可以了 ^_^

GBKEE

回復 12# wufonna
2010版的找不到圖片如何更名
如圖 到名稱方塊中修改

下載 (37.92 KB)

2014-12-14 05:45

VBA修改

1. With 工作表1
   
2.     .Shapes(1).Name = "驗證圖"
   
3.     .Shapes("驗證圖").Fill.UserPicture 圖形    '
   
4. End With

複製代碼

HSIEN6001

回復 14# GBKEE

下載 (51.05 KB)

2014-12-14 12:17

請問,該如何載入其他頁次
若不用寫入Excel,而直接 .Click 下載CSV檔(BIG5) 檔案
語法該怎麼修正

1.         Set aa = .Document.getElementsByTAGName("INPUT")
   
2.         For R = 0 To aa.Length - 1
   
3.             If aa(R).Value = "下載CSV檔(BIG5)" And aa(R).Type = "button" Then
   
4.                 aa(R).Click   '有 "下載CSV檔(BIG5)" 的按鈕
   
5.                     Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
   
6.             End If
   
7.         Next

複製代碼

wufonna

回復 14# GBKEE

原來就在面前 哈
謝謝 GBKEE 大大

wufonna

回復 14# GBKEE


    請問 大大 第一段對應的是這程式碼嗎，那第二段的我這樣改為何查無該股票代碼資料
諸問 大大 如何有誤，改如何做練習，謝謝


<button type="submit" class="btn btn-default"><span class="glyphicon glyphicon-search" aria-hidden="true"></span>&nbsp;查詢</button>

      Set a = .Document.ALL.tags("BUTTON")
        For Each e In a
            If Trim(e.innertext) = "查詢" And e.ID = "" Then
            e.Click
            Exit For
            End If
        Next

<input type="radio" id="rdo_search_stk" tabindex="14" name="rdo_search" value="1" class="input-radio-search" checked><span>個股查詢</span>
<button id="header_search_btn" tabindex="17" class="input-button ui-corner-all" tabindex="13">搜尋</button>       

Sub test()
Dim e As Object, a As Object
    Set IE = CreateObject("InternetExplorer.Application")
   
    With IE
        .Visible = True
        '券商買賣證券日報表查詢系統（一般交易）
        .Navigate "http://www.gretai.org.tw/web/stock/aftertrading/broker_trading/brokerBS.php?l=zh-tw"
        Do While .Busy Or .readyState <> 4: DoEvents: Loop
        .Document.ALL.tags("INPUT")("rdo_search_stk").Value = 1
        .Document.ALL.tags("INPUT")("input_search_site").Value = Trim(1258)
        Set a = .Document.ALL.tags("BUTTON")
        For Each e In a
        If e.ID = "header_search_btn" Then
            e.Click
            Exit For
        End If
        Next
    End With
End Sub

wufonna

回復 14# GBKEE


    謝謝 GBKEE 版大
   是我看錯了
   
        .Document.ALL.tags("INPUT")("input_search_stk").Value = Trim(1258)

GBKEE

回復 15# HSIEN6001

若不用寫入Excel,而直接 .Click 下載CSV檔(BIG5) 檔案
對IE的涉獵尚淺找不出下載CSV檔的參數,有請高手指點

載入其他頁次
Dim IEx As Object  '工作表模組

1. Private Sub 日報表載入()
   
2.     Dim e As Object, A As Object, k  As Integer, i As Integer, S As String
   
3.     If IE Is Nothing Then
   
4.         圖形更新
   
5.         MsgBox "驗證圖已更新"
   
6.         Exit Sub
   
7.     End If
   
8.     With IE
   
9.         .Document.all.tags("INPUT")("stk_code").Value = Range(證券代號)
   
10.         .Document.all.tags("INPUT")("auth_num").Value = Trim(Range(驗證碼))
    
11.         Set A = .Document.all.tags("BUTTON")
    
12.         For Each e In A
    
13.             If Trim(e.Innertext) = "查詢" And e.ID = "" Then
    
14.             e.Click
    
15.             Exit For
    
16.             End If
    
17.         Next
    
18.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
    
19.         UsedRange.Offset(6).Clear
    
20.         Range("a" & k + 1) = S
    
21.         If .Document.body.Innertext Like "***該股票該日無交易資訊***" Then S = "***該股票該日無交易資訊***"
    
22.         If .Document.body.Innertext Like "***驗證碼錯誤，請重新查詢。***" Then S = "***驗證碼錯誤，請重新查詢。*** "
    
23.         If S <> "" Then
    
24.             Range("a" & k + 1) = S
    
25.             MsgBox S
    
26.             GoTo NN
    
27.         End If
    
28.         Set IEx = CreateObject("InternetExplorer.Application")
    
29.         IEx.Navigate "about:Tabs"
    
30.         Set A = .Document.all.tags("A")
    
31.         單頁載入 .Document.all.tags("table")(0).outerHTML
    
32.         [A6].Select
    
33.         '********程式碼寫在工作表模組: Me 指這工作表模組
    
34.         Me.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
    
35.         '****************************************
    
36.         If A.Length = 459 Then
    
37.             For i = 2 To 3
    
38.                 單頁載入 .Document.all.tags("table")(i).outerHTML
    
39.                 With Range("A" & Rows.Count).End(xlUp).Offset(1)
    
40.                     .Select
    
41.                     Me.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
    
42.                 End With
    
43.             Next
    
44.         Else
    
45.             For k = 0 To A.Length - 1
    
46.                 If Val(A(k).Innertext) >= 1 Then
    
47.                     Debug.Print A(k).Innertext
    
48.                     A(k).Click
    
49.                     Do While .Busy Or .readyState <> 4: DoEvents: Loop
    
50.                     Set A = .Document.all.tags("A")
    
51.                     Do While .Busy Or .readyState <> 4: DoEvents: Loop
    
52.                     For i = 2 To 3
    
53.                         單頁載入 .Document.all.tags("table")(i).outerHTML
    
54.                         With Range("A" & Rows.Count).End(xlUp).Offset(1)
    
55.                             .Select
    
56.                             Me.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
    
57.                         End With
    
58.                     Next
    
59.                 End If
    
60.             Next
    
61.         End If
    
62.         IEx.Quit
    
63.         Set IEx = Nothing
    
64.         整理
    
65. NN:
    
66.         .Quit
    
67.     End With
    
68.     Set IE = Nothing
    
69.     圖形更新
    
70. End Sub
    
71. Private Sub 單頁載入(S)
    
72.     With IEx
    
73.         .Document.body.innerHTML = S
    
74.         .ExecWB 17, 2       '  Select All
    
75.         .ExecWB 12, 2       '  Copy selection
    
76.     End With
    
77. End Sub
    
78. Private Sub 整理()
    
79.     On Error Resume Next
    
80.     Application.EnableEvents = False
    
81.     With UsedRange.Offset(10)
    
82.         .Replace "序號", "=ex", xlWhole
    
83.         .SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
    
84.     End With
    
85.     UsedRange(1).Select
    
86.     Application.EnableEvents = True
    
87. End Sub

複製代碼

HSIEN6001

回復 19# GBKEE

耶!成了

謝謝您的指導！
程式語言，博大精深
對我來說很艱難，因為好用，還是很努力的盡量多吸收一些
還沒看懂的部分，也先收集起來，待日後消化

~感恩~