麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 檔案下載問題 [打印本頁]

作者: spermbank 時間: 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中基本面資料夾為網路搜尋，個股基本分析，分享給有研究股票的論壇朋友。

作者: spermbank 時間: 2011-10-1 09:35

請問大大可不可以先幫我處理一下第1個問題，因為12個檔案未開放巨集程式碼，要12個檔案更新12次真的很麻煩，想說用一個excel再把12檔案串連起來，只要更新1次，並且下載所有代號存檔，速度，什麼都會變很快說。

作者: spermbank 時間: 2011-10-2 11:57

請問一下:
那我要怎麼再我自己的excel檔，去執行其他excel的巨集(未開放程式碼)呢?

作者: Hsieh 時間: 2011-10-2 17:26

本帖最後由 Hsieh 於 2011-10-2 17:48 編輯

回復 3# spermbank

看不懂你的整體流程
你是要把12個檔案全部以一個公司代碼完成更新後，再將風險評估與獲利指標2個檔案內的那些工作表以代號為名另存新檔嗎?
但不是12個檔案都有"載入個股資料"的程式碼阿

作者: spermbank 時間: 2011-10-3 01:39

本帖最後由 spermbank 於 2011-10-3 02:13 編輯

回復 4# Hsieh

為什麼可以看到><"
我是用2007版excel
想看程式碼，可是卻出現"專案無法檢視"

我已經把安全性調成:啟用所有巨集(不建議使用；會執行有潛在危險的程式碼)
                                 信任存取VBA專案物件模型

   仍然不行說
   請大大指教

作者: luhpro 時間: 2011-10-3 21:24

本帖最後由 luhpro 於 2011-10-3 21:38 編輯

回復 Hsieh
想看程式碼，可是卻出現"專案無法檢視"
spermbank 發表於 2011-10-3 01:39

晤...
那就是檔案有設定保護 -> 原設計者 "不想讓別人看到程式碼",
而你想從其他檔案去呼叫該按鈕的 Click 程序也沒輒(只要他是設成 Private),
建議你還是去找本人問比較適合.

作者: Hsieh 時間: 2011-10-3 22:52

本帖最後由 Hsieh 於 2011-10-3 22:53 編輯

回復 5# spermbank

我不善於破解
但依你敘述或許可試試在個股基本面分析.xls一般模組
執行更新主程序試試

Sub 更新主程序()
With ThisWorkbook
For Each a In .Sheets(1).[A2:A1341] '每個代號循環
更新資料 a '執行12檔案更新
Workbooks("風險評估.xls").Sheets(Array("IS", "ISQ", "BS", "BSQ", "BASIC", "YrPrice", "FR", "CFS", "ISQT")).Copy '複製工作表
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & CStr(a) & ".xls" '另存新檔
Workbooks("營業收入變動.xls").Sheets("Revenue").Copy Before:=Workbooks(CStr(a) & ".xls").Sheets(1) '複製工作表
關檔
Next
End With
End Sub
Sub 更新資料(a)
Dim Sh As Worksheet, MyURL$, MyQy As QueryTable
With ThisWorkbook
fd = .Path & "\基本面\"
fs = Dir(fd & "*.xls")
Do Until fs = ""
With Workbooks.Open(fd & fs)
For Each Sh In .Sheets
With Sh
If .QueryTables.Count > 0 Then
Set MyQy = .QueryTables(1)
With .QueryTables(1)
MyURL = .Connection
If InStr(MyURL, "StockID") > 0 Then
k = Val(Split(MyURL, "=")(UBound(Split(MyURL, "="))))
Else
k = Val(Split(MyURL, "_")(1))
End If
MyURL = Replace(MyURL, k, a)
.Connection = MyURL '更改查詢
.BackgroundQuery = False '幕前更新
.Refresh '更新
End With
End If
End With
Next
End With
fs = Dir()
Loop
End With
End Sub
Sub 關檔()
For Each w In Windows
If w.Caption <> ThisWorkbook.Name Then w.Close 1
Next
End Sub

複製代碼

作者: spermbank 時間: 2011-10-4 19:54

回復 7# Hsieh

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

作者: Hsieh 時間: 2011-10-4 20:06

回復 8# spermbank
要另存成xlsx檔案，前面的存檔就要一起改成xlsx
之前提到的不是每個檔案都有該程序，是因為我測試時沒有開放巨集導致誤解
原作者以按鈕驅動模組內程序，可利用複製工作表，就能看到工作表模組內程式碼
但是若要看到全部程式碼就必須破解，況且每個檔案程式碼是以InputBox輸入代碼
所以，要每個檔案修改程式碼不如重新撰寫

作者: spermbank 時間: 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大教我的下載、速度問題相關程式，如法炮製的寫寫看。
若不行再請大大協助。

作者: Hsieh 時間: 2011-10-5 15:29

回復 10# spermbank

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

作者: spermbank 時間: 2011-10-6 09:35

回復 11# Hsieh

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

作者: sp218882 時間: 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

作者: sp218882 時間: 2011-10-22 01:14

請問
本案與 http://forum.twbts.com/thread-4906-1-1.html 是否
有相同內容，或許可供參考

作者: spermbank 時間: 2011-10-22 13:08

回復 14# sp218882

嗯嗯，謝謝你^^

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)