12
返回列表 上一主題 發帖

[發問] 檔案下載問題

spermbank

帖子
94 
主題
28 
精華
0 
積分
145 
點名
0  
作業系統
windows 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2011-9-22 
最後登錄
2021-10-18 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2011-9-30 12:30 | 只看該作者

[發問] 檔案下載問題

本帖最後由 spermbank 於 2011-10-1 09:32 編輯

各位大大好:
基本面資料夾中有12個檔案，可是每個檔案第1個sheet1有個按鈕"輸入個股"未開放巨集程式碼，且按下按鈕後會請求"請輸入個股代號"，我想從我自己設計的"個股基本面分析.xls"中的工作列-首頁1..
新增
    1、按下"下載所有股票基本面資料"會將首頁1的所有代號中的資料，依序存入檔案路徑中D:\data\(檔名為代號)
          (其中，所有代號中的資料內容包含:風險評估.xls把更新過後的工作列-IS、ISQ、BS、BSQ、BASIC、YrPrice、FR、CFS、ISQT及獲利指標.xls把更新過後的工作列-Revenue)
    因為基本面資料夾中有12個檔案未開放巨集程式碼，所以想請問大家及G大這要怎麼寫。

    2、按下"匯入個股資料"會跳出視窗顯示"請輸入個股代號"並且直接更新基本面資料夾中12個檔案，再把資料夾匯入我自己的"個股基本分析.xls"中的各工作列表.
         (舉例:從風險評估.xls把更新過後的工作列-IS、ISQ、BS、BSQ、BASIC、YrPrice、FR、CFS、ISQT匯入對應的工作列表中...)
PS:test.rar中基本面資料夾為網路搜尋，個股基本分析，分享給有研究股票的論壇朋友。

test.rar (502.82 KB)

收藏 分享

spermbank

帖子
94 
主題
28 
精華
0 
積分
145 
點名
0  
作業系統
windows 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2011-9-22 
最後登錄
2021-10-18 
15#
發表於 2011-10-22 13:08 | 只看該作者
回復 14# sp218882


    嗯嗯，謝謝你^^

TOP

sp218882

帖子
4 
主題
1 
精華
0 
積分
10 
點名
0  
作業系統
XP 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
來自
彰化 
註冊時間
2011-9-30 
最後登錄
2013-11-4 

論壇贊助勳章
14#
發表於 2011-10-22 01:14 | 只看該作者
請問
本案與  http://forum.twbts.com/thread-4906-1-1.html  是否
有相同內容，或許可供參考

TOP

sp218882

帖子
4 
主題
1 
精華
0 
積分
10 
點名
0  
作業系統
XP 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
來自
彰化 
註冊時間
2011-9-30 
最後登錄
2013-11-4 

論壇贊助勳章
13#
發表於 2011-10-21 23:07 | 只看該作者
以市場上office相容軟體（Open Office＿Calc ）打開檔案後，即可看到程式碼
也就是MS Office Excel 密碼功能對相容軟體（Open Office）是沒有用的
我嘗試打開   獲利指標.xls 看到巨集指令如下
Rem Attribute VBA_ModuleType=VBAModule
Sub Module1
Rem Sub 更新個股資料()
Rem     On Error Resume Next
Rem     Dim StockNum As String
Rem 0
Rem     StockNum = Application.InputBox("請輸入個股代號")
Rem     If StockNum <> "" Then
Rem     If Asc(StockNum) >= 48 And Asc(StockNum) <= 57 Then GoTo 1 '判定為數字就進行
Rem     End If
Rem     If StockNum = "False" Then GoTo 2   '若取消則退出
Rem     MsgBox ("請輸入個股代號")
Rem     GoTo 0
Rem 1
Rem     Sheets("IS").Select
Rem     With Selection.QueryTable
Rem         .Connection = "URL;http://dj.mybank.com.tw/z/zc/zcq/zcqa/zcqa_" & StockNum & ".asp.htm"
Rem         .WebSelectionType = xlSpecifiedTables
Rem         .WebFormatting = xlWebFormattingNone
Rem         .WebTables = "3"
Rem         .WebPreFormattedTextToColumns = True
Rem         .WebConsecutiveDelimitersAsOne = True
Rem         .WebSingleBlockTextImport = False
Rem         .WebDisableDateRecognition = False
Rem         .WebDisableRedirections = False
Rem         .Refresh BackgroundQuery:=False
Rem     End With
Rem     Selection.QueryTable.Refresh BackgroundQuery:=False
Rem
Rem     Sheets("ISQ").Select
Rem     With Selection.QueryTable
Rem         .Connection = "URL;http://dj.mybank.com.tw/z/zc/zcq/zcq_" & StockNum & ".asp.htm"
Rem         .WebSelectionType = xlSpecifiedTables
Rem         .WebFormatting = xlWebFormattingNone
Rem         .WebTables = "3"
Rem         .WebPreFormattedTextToColumns = True
Rem         .WebConsecutiveDelimitersAsOne = True
Rem         .WebSingleBlockTextImport = False
Rem         .WebDisableDateRecognition = False
Rem         .WebDisableRedirections = False
Rem         .Refresh BackgroundQuery:=False
Rem     End With
Rem     Selection.QueryTable.Refresh BackgroundQuery:=False
Rem     
Rem     Sheets("指標圖表").Select
Rem 2
Rem End Sub
Rem
Rem
End Sub

TOP

spermbank

帖子
94 
主題
28 
精華
0 
積分
145 
點名
0  
作業系統
windows 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2011-9-22 
最後登錄
2021-10-18 
12#
發表於 2011-10-6 09:35 | 只看該作者
回復 11# Hsieh


    謝謝大大，我再想想，確實有這工作簿，副檔名我也沒弄錯。
    感謝大大指教^^

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
253  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-22 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
11#
發表於 2011-10-5 15:29 | 只看該作者
回復 10# spermbank

關於程式碼出錯
請檢查Workbooks("營業收入變動.xls").Sheets("Revenue")    此工作表是否存在?(注意工作簿副檔名是否正確)
學海無涯_不恥下問

TOP

spermbank

帖子
94 
主題
28 
精華
0 
積分
145 
點名
0  
作業系統
windows 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2011-9-22 
最後登錄
2021-10-18 
10#
發表於 2011-10-5 14:00 | 只看該作者
本帖最後由 spermbank 於 2011-10-5 14:04 編輯

回復 9# Hsieh
H大你好:
我將程式碼改成
    With ThisWorkbook
    For Each a In .Sheets(1).[A2:A1341] '每個代號循環
      Application.ScreenUpdating = False       '停止螢幕更新
      更新資料 a '執行12檔案更新
      Workbooks("風險評估.xls").Sheets(Array("IS", "ISQ", "BS", "BSQ", "BASIC", "YrPrice", "FR", "CFS", "ISQT")).Copy '複製工作表
      ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & CStr(a) & ".xlsx" '另存新檔
      Workbooks("營業收入變動.xls").Sheets("Revenue").Copy Before:=Workbooks(CStr(a) & ".xlsx").Sheets(1) '複製工作表
      關檔
    Next
    Application.ScreenUpdating = False       '停止螢幕更新
    End With
    仍然出現下列錯誤
    執行階段錯誤 ‘1004’ :
    Class Worksheet的Copy方法失敗
另外:
    H大說:原作者以按鈕驅動模組內程序，可利用複製工作表，就能看到工作表模組內程式碼，我不知道如何看到，不了解大大意思。
    想請教大大是不是可以看到部分的程式碼中看到下載更新的網址及相關程式碼、可以貼給我，或許我可以用G大教我的下載、速度問題相關程式，如法炮製的寫寫看。
    若不行再請大大協助。

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
253  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-22 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
9#
發表於 2011-10-4 20:06 | 只看該作者
回復 8# spermbank
要另存成xlsx檔案，前面的存檔就要一起改成xlsx
之前提到的不是每個檔案都有該程序，是因為我測試時沒有開放巨集導致誤解
原作者以按鈕驅動模組內程序，可利用複製工作表，就能看到工作表模組內程式碼
但是若要看到全部程式碼就必須破解，況且每個檔案程式碼是以InputBox輸入代碼
所以，要每個檔案修改程式碼不如重新撰寫
學海無涯_不恥下問

TOP

spermbank

帖子
94 
主題
28 
精華
0 
積分
145 
點名
0  
作業系統
windows 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2011-9-22 
最後登錄
2021-10-18 
8#
發表於 2011-10-4 19:54 | 只看該作者
回復 7# Hsieh


              Workbooks("營業收入變動.xlsm").Sheets("Revenue").Copy Before:=Workbooks(CStr(a) & ".xlsx").Sheets(1) '複製工作表
在執行程式時這上述兩行程式時，出現"ClassWorksheet的Copy方法失敗"
不知道如何解決，請大大指點。
另:
      大大回復的問題中
     但不是12檔案中都有"輸入個股資料"的程式碼
     是不是要用2003版本開就可以看到呢?
     還是只有破解一途呢?

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
253  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-22 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
7#
發表於 2011-10-3 22:52 | 只看該作者
本帖最後由 Hsieh 於 2011-10-3 22:53 編輯

回復 5# spermbank

我不善於破解
但依你敘述或許可試試在個股基本面分析.xls一般模組
執行更新主程序試試
  1. Sub 更新主程序()
  2. With ThisWorkbook
  3. For Each a In .Sheets(1).[A2:A1341] '每個代號循環
  4.   更新資料 a '執行12檔案更新
  5.   Workbooks("風險評估.xls").Sheets(Array("IS", "ISQ", "BS", "BSQ", "BASIC", "YrPrice", "FR", "CFS", "ISQT")).Copy '複製工作表
  6.   ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & CStr(a) & ".xls" '另存新檔
  7.   Workbooks("營業收入變動.xls").Sheets("Revenue").Copy Before:=Workbooks(CStr(a) & ".xls").Sheets(1) '複製工作表
  8.   關檔
  9. Next
  10. End With
  11. End Sub
  12. Sub 更新資料(a)
  13. Dim Sh As Worksheet, MyURL$, MyQy As QueryTable
  14. With ThisWorkbook
  15. fd = .Path & "\基本面\"
  16. fs = Dir(fd & "*.xls")
  17. Do Until fs = ""
  18. With Workbooks.Open(fd & fs)
  19.    For Each Sh In .Sheets
  20.       With Sh
  21.       If .QueryTables.Count > 0 Then
  22.          Set MyQy = .QueryTables(1)
  23.          With .QueryTables(1)
  24.          MyURL = .Connection
  25.          If InStr(MyURL, "StockID") > 0 Then
  26.             k = Val(Split(MyURL, "=")(UBound(Split(MyURL, "="))))
  27.             Else
  28.             k = Val(Split(MyURL, "_")(1))
  29.          End If
  30.          MyURL = Replace(MyURL, k, a)
  31.          .Connection = MyURL '更改查詢
  32.          .BackgroundQuery = False '幕前更新
  33.          .Refresh '更新
  34.          End With
  35.       End If
  36.       End With
  37.    Next
  38. End With
  39. fs = Dir()
  40. Loop
  41. End With
  42. End Sub
  43. Sub 關檔()
  44. For Each w In Windows
  45. If w.Caption <> ThisWorkbook.Name Then w.Close 1
  46. Next
  47. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 人生沒有所有權，只有生命的使用權。
12
返回列表 上一主題