- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
45#
發表於 2013-8-4 07:22
| 只看該作者
本帖最後由 c_c_lai 於 2013-8-4 07:27 編輯
回復 44# slip - Sub GetDDE()
- Dim T As Date, Sh(1 To 2), i As Long
-
- T = Now '取得現在時間
- Set Sh(1) = ThisWorkbook.Sheets(1)
- Set Sh(2) = ThisWorkbook.Sheets(2)
- If Not IsError(Sh(1).[B2]) Then Sh(2).[A65536].End(xlUp).Offset(1).Resize(, 7) = Sh(1).[A2:G2].Value '工作表1的資料DDE連結成功寫入工作表2
- With ThisWorkbook.Sheets(2).[A65536].End(xlUp).Offset(1) '物件
- i = .Row
- .Range("H1") = .Range("D1") - .Range("C1") 'H欗的公式=>D欗-C欗
- .Range("I1") = .Range("H1") - .Range("H1").Offset(-1) 'I413=H413-H412......數列2
- .Range("J1") = .Range("E1") 'J欗的公式=E欗
- xMax = Application.Max(.Parent.[i:j]) '最大值
- xMin = Application.Min(.Parent.[i:j]) '最小值
- '** .Parent.ChartObjects(1): 物件 (工作表的第1個圖表) *****
- With .Parent.ChartObjects(1).Chart
- .SeriesCollection(1).Values = .Parent.Parent.Range("i2:i" & i) '指定數列資料的範圍
- .SeriesCollection(1).ChartType = 52 '指定數列圖表類型
- .SeriesCollection(2).Values = .Parent.Parent.Range("J2:J" & i)
- .SeriesCollection(2).ChartType = 65
- If .SeriesCollection(2).AxisGroup <> xlSecondary Then .SeriesCollection(2).AxisGroup = xlSecondary '數列不在第2Y座標軸(副座標): 數列指定到第2Y座標軸(副座標)
- '.AxisGroup = 2 -> 副座標
- .Parent.Top = .Parent.Parent.Range("L" & IIf(i <= 39, 1, i - 38)).Top '指定圖表頂端的位置
- With .Axes(xlValue) 'Y(主)座標軸
- .MinimumScale = Application.Min(.Parent.Parent.Parent.[I:I]) '最小值
- .MaximumScale = Application.Max(.Parent.Parent.Parent.[I:I]) '最大值
- .MajorUnitIsAuto = True '主要刻度間距=自動設定
- .MinorUnitIsAuto = True '次要刻度間距=自動設定
- .Crosses = xlAutomatic '座標軸與其他座標軸交叉的點=自動設定
- .ScaleType = xlLinear '數值座標軸的刻度類型=xlLinear
- End With
- With .Axes(xlValue, xlSecondary) 'Y(副)座標軸
- .MinimumScale = Application.Min(.Parent.Parent.Parent.[J:J]) '最小值
- .MaximumScale = Application.Max(.Parent.Parent.Parent.[J:J]) '最大值
- .MaximumScaleIsAuto = True
- .MajorUnitIsAuto = True
- .MinorUnitIsAuto = True
- .Crosses = xlAutomatic
- .ScaleType = xlLinear
- End With
- End With
- End With
- Application.ScreenUpdating = True
- Application.OnTime T + TimeValue("00:00:05"), "GetDDE" '間隔5分鐘改成TimeValue("00:05:00"),
- End Sub
網站圖片功能可能被異動了，故無法上傳圖片故改以貼示程式碼。 |
|
發表於 2013-8-1 13:19
| 
