返回列表 上一主題 發帖

將資料改為觸發型式

wl02353427

帖子
30 
主題
4 
精華
0 
積分
34 
點名
0  
作業系統
Win10 
軟體版本
Office 2010 
閱讀權限
10 
性別
男 
來自
新北市 
註冊時間
2013-11-30 
最後登錄
2023-1-12 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2013-12-1 17:37 | 只看該作者

將資料改為觸發型式

本帖最後由 wl02353427 於 2013-12-1 17:38 編輯

我想將擷取資料改為觸發式或在設定期間內執行擷取，就是以一個控制器來啟動和停止，可是改來改去一直失敗...目前只會一直抓...然後得自己進入vba按停止...可否有大大可以幫幫忙

上傳資料.rar (43.06 KB)

收藏 分享
初新者~指教囉~

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
6#
發表於 2013-12-5 00:23 | 只看該作者
回復 5# stillfish00

了解! 謝謝你的回覆
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
5#
發表於 2013-12-4 23:33 | 只看該作者
本帖最後由 stillfish00 於 2013-12-4 23:35 編輯

回復 4# ML089
SparklineGroup 是 Excel 2010 新增的物件，估計2007是沒辦法直接用了。

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
4#
發表於 2013-12-4 20:25 | 只看該作者
回復 2# Hsieh

我的EXCEL是2007版，執行後出現錯誤，不知道還要設定哪些東東

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

wl02353427

帖子
30 
主題
4 
精華
0 
積分
34 
點名
0  
作業系統
Win10 
軟體版本
Office 2010 
閱讀權限
10 
性別
男 
來自
新北市 
註冊時間
2013-11-30 
最後登錄
2023-1-12 
3#
發表於 2013-12-4 18:22 | 只看該作者
回復 2# Hsieh

感謝超級版主:'( 一直嘗試寫一個控制器可是都失敗，萬分感謝。Orz
初新者~指教囉~

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2013-12-2 15:09 | 只看該作者
回復 1# wl02353427
  1. Public NameOfThisProcedure
  2. Public NextTime
  3. Sub Stop_Update()
  4. Yn = MsgBox("確定停止" & NameOfThisProcedure & "程序" & Chr(10) & NextTime & "的更新?", vbYesNo)
  5. If Yn = 6 Then Application.OnTime EarliestTime:=NextTime, Procedure:=NameOfThisProcedure, schedule:=False
  6. End Sub
  7. Sub Awesome()
  8. '****************************截取資料並記錄****************************'
  9.     Dim SG As SparklineGroup
  10.     Dim SL As Sparkline
  11.     Dim WSD As Worksheet
  12.     Dim WSL As Worksheet
  13.     Dim WSQ As Worksheet
  14.     Set WSQ = Worksheets("工作表1")
  15.    
  16.     hiji = Now()
  17.    
  18.     WaitSec = 30 '延遲時間
  19.     NameOfThisProcedure = "Awesome"
  20.    

  22.     NextTime = Now + TimeSerial(0, 0, WaitSec) ' 延遲
  23.    
  24.     Application.OnTime EarliestTime:=NextTime, Procedure:=NameOfThisProcedure ' 利用OnTime指令排定 Awesome 的執行時間
  25.    
  26.     WSQ.Range("B3").QueryTable.Refresh BackgroundQuery:=False '重新整理web查詢
  27.    
  28.     Application.Wait (Now + TimeValue("0:00:05")) ' 確認資料更新

  30.     NextRow = WSQ.Cells(Rows.Count, 2).End(xlUp).Row + 1
  31.     WSQ.Range("B3:K3").Copy WSQ.Cells(NextRow, 2)
  32.    
  33. '**********************************************************************'

  35. On Error Resume Next
  36.    Application.DisplayAlerts = False
  37.    Worksheets("工作表2").Delete
  38. On Error GoTo 0

  40. Set WSD = Worksheets("工作表1") ' 資料讀取
  41. Set WSL = ActiveWorkbook.Worksheets.Add ' 儀錶板輸出
  42.     WSL.Name = "工作表2"

  44. WSL.Select

  46. '***儀錶板大小***'
  47. With WSL.Range("B2")
  48.     .ColumnWidth = 100 ' 高度
  49.     .RowHeight = 100  ' 寬度
  50. End With

  52. '****標題名稱****'
  53. With WSL.Range("B1")
  54.     .Value = Array("張數")
  55.     .HorizontalAlignment = xlCenter
  56.     .ColumnWidth = 39
  57.     .Offset(1, 0).RowHeight = 200
  58. End With

  60. Set SG = WSL.Range("B2").SparklineGroups.Add(Type:=xlSparkLine, SourceData:="工作表1!G8:G" & NextRow)
  61.     SG.SeriesColor.Color = RGB(0, 0, 255) ' 線條顏色

  63. Set SL = SG.Item(1)

  65. '***背景顏色***'
  66. With WSL.Range("B2").Interior
  67.     .Color = RGB(255, 255, 255)
  68.     .TintAndShade = 0
  69. End With
  70.    
  71. Set SL = SG.Item(1)

  73. '***最大最小值***'
  74. Set AF = Application.WorksheetFunction
  75.     AllMin = AF.Min(WSD.Range("G8:G65536")) ' 指定區域中選出最小值
  76.     AllMax = AF.Max(WSD.Range("G8:G65536"))
  77.     AllMin = Int(AllMin) - AllMin ' 整數設定
  78.     AllMax = Int(AllMax)

  80. With SG.Axes.Vertical
  81.     .MinScaleType = xlSparkScaleCustom
  82.     .MaxScaleType = xlSparkScaleCustom
  83.     .CustomMinScaleValue = AllMin
  84.     .CustomMaxScaleValue = AllMax
  85. End With

  87. '***[A2]上下間距***'
  88. With WSL.Range("A2")
  89.      .Value = AllMax & vbLf & vbLf & vbLf & vbLf _
  90.             & vbLf & vbLf & vbLf & vbLf & vbLf & vbLf & vbLf & vbLf & vbLf & vbLf & vbLf & vbLf & vbLf & vbLf & AllMin
  91.      .HorizontalAlignment = xlRight
  92.      .VerticalAlignment = xlTop
  93.      .Font.Size = 8
  94.      .Font.Bold = True
  95.      .WrapText = True
  96.     End With

  98. '***其他設定***'
  99. Worksheets("工作表2").Range("B3") = "更新日期 : " & hiji

  101. Number = WSD.Range("G8:G" & NextRow).Count
  102. Worksheets("工作表1").Range("M2") = "資料筆數 :"
  103. Worksheets("工作表1").Range("N2") = Number

  105. Workbooks(1).Save

  107. Set WSQ = Nothing
  108. Set QSL = Nothing

  110. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 多做多得。少做多失。
返回列表 上一主題