■xl2003：Series.ErrorBar メソッド

昨日のコードはxl2007|xl2010用です。ついでに、xl97-xl2003で動作確認したコードはこちら。
（太字が変更点）

Option Explicit

Sub 準備() 'Sheet追加しダミーデータセット
　　With Sheets.Add
　　　　.Range("A1:D1").Value = Array("日付", "数値", "タテ軸", "ヨコ軸")
　　　　.Range("A2:D2").Value = Array(#1/1/2011#, "=INT(RAND()*100)", #1/15/2011#, 55)
　　　　With .Range("A2:B22")
　　　　　　.Range("A1:B1").AutoFill Destination:=.Cells, Type:=xlFillDefault
　　　　　　.Columns(1).NumberFormat = "m/d"
　　　　　　.Range("C1").NumberFormat = "m/d"
　　　　　　.Columns(2).Value = .Columns(2).Value
　　　　End With
　　End With
End Sub
'-------------------------------------------------
Sub try2003() '追加したSheetをActiveにして実行
　　Dim ws As Worksheet
　　Dim r　As Range

　　Set ws = ActiveSheet
　　'r = Chart起点
　　Set r = ws.Range("D4")
　　'誤差量用。2003では名前定義ではなくセルに数式をセット
　　ws.Range("C3").Formula = "=MAX($A:$A)-MIN($A:$A)"
　　ws.Range("D3").Formula = "=MAX($B:$B)-MIN($B:$B)"
　　With ws.ChartObjects.Add(r.Left, r.Top, 300, 200).Chart
　　　　'散布図直線Chart
　　　　.ChartType = xlXYScatterLinesNoMarkers
　　　　.HasLegend = False
　　　　'r = SourceDataをセットし直し
　　　　Set r = ws.Range("B2", ws.Cells(ws.Rows.Count, 1).End(xlUp))
　　　　.SetSourceData Source:=r, PlotBy:=xlColumns
　　　　'系列2追加
　　　　With .SeriesCollection.NewSeries
　　　　　　.XValues = ws.Range("C2")
　　　　　　.Values = ws.Range("D2")
　　　　　　'誤差範囲を設定
　　　　　　.ErrorBar Direction:=xlX, _
　　　　　　　　　　　Include:=xlBoth, _
　　　　　　　　　　　Type:=xlErrorBarTypeCustom, _
　　　　　　　　　　　Amount:=ws.Range("C3"), _
　　　　　　　　　　　MinusValues:=ws.Range("C3")
　　　　　　.ErrorBar Direction:=xlY, _
　　　　　　　　　　　Include:=xlBoth, _
　　　　　　　　　　　Type:=xlErrorBarTypeCustom, _
　　　　　　　　　　　Amount:=ws.Range("D3"), _
　　　　　　　　　　　MinusValues:=ws.Range("D3")
　　　　　　'誤差範囲の線スタイル設定
　　　　　　With .ErrorBars
　　　　　　　　.EndStyle = xlNoCap
　　　　　　　　.Border.LineStyle = xlDash
　　　　　　End With
　　　　End With
　　　　'系列1を折れ線Chartに変更
　　　　.SeriesCollection(1).ChartType = xlLine
　　　　'軸のMin,Max設定
　　　　With .Axes(xlValue)
　　　　　　.MinimumScale = Application.Min(r.Columns(2), 0)
　　　　　　.MaximumScale = Application.Ceiling( _
　　　　　　　　　　　　　　Application.Max(r.Columns(2)), 10)
　　　　End With
　　　　With .Axes(xlCategory)
　　　　　　.MinimumScale = Application.Min(r.Columns(1))
　　　　　　.MaximumScale = Application.Max(r.Columns(1))
　　　　　　.TickLabels.NumberFormat = "m/d"
　　　　End With
　　　　'ChartObjectをActiveにした後ErrorBarをSelectして処理
　　　　.Parent.Activate
　　End With
　　'誤差範囲線の色変更
　　Application.ExecuteExcel4Macro ("SELECT(""系列 2 X 誤差範囲"")")
　　Selection.Border.Color = vbRed
　　Application.ExecuteExcel4Macro ("SELECT(""系列 2 Y 誤差範囲"")")
　　Selection.Border.Color = vbGreen

　　Set r = Nothing
　　Set ws = Nothing
End Sub

■xl2007：Series.ErrorBar メソッド

エクセル　グラフにセルの値を参照した目盛を入れたい - 教えて！goo
終わった後にふと..誤差範囲の線を使うのもありかも。などと思ってしまう。

Option Explicit

Sub 準備() 'Sheet追加しダミーデータセット
　　With Sheets.Add
　　　　.Range("A1:D1").Value = Array("日付", "数値", "タテ軸", "ヨコ軸")
　　　　.Range("A2:D2").Value = Array(#1/1/2011#, "=INT(RAND()*100)", #1/15/2011#, 55)
　　　　With .Range("A2:B22")
　　　　　　.Range("A1:B1").AutoFill Destination:=.Cells, Type:=xlFillDefault
　　　　　　.Columns(1).NumberFormat = "m/d"
　　　　　　.Range("C1").NumberFormat = "m/d"
　　　　　　.Columns(2).Value = .Columns(2).Value
　　　　End With
　　End With
End Sub
'-------------------------------------------------
Sub try() '追加したSheetをActiveにして実行
　　Dim ws As Worksheet
　　Dim r　As Range

　　Set ws = ActiveSheet
　　'r = Chart起点
　　Set r = ws.Range("D4")
　　'誤差量用に名前定義
　　ws.Names.Add Name:="maxA", RefersTo:="=MAX($A:$A)-MIN($A:$A)"
　　ws.Names.Add Name:="maxB", RefersTo:="=MAX($B:$B)-MIN($B:$B)"
　　With ws.ChartObjects.Add(r.Left, r.Top, 300, 200).Chart
　　　　'散布図直線Chart
　　　　.ChartType = xlXYScatterLinesNoMarkers
　　　　.HasLegend = False
　　　　'r = SourceDataをセットし直し
　　　　Set r = ws.Range("B2", ws.Cells(ws.Rows.Count, 1).End(xlUp))
　　　　.SetSourceData Source:=r, PlotBy:=xlColumns
　　　　'系列2追加
　　　　With .SeriesCollection.NewSeries
　　　　　　.XValues = ws.Range("C2")
　　　　　　.Values = ws.Range("D2")
　　　　　　'誤差範囲を設定
　　　　　　.ErrorBar Direction:=xlX, _
　　　　　　　　　　　Include:=xlBoth, _
　　　　　　　　　　　Type:=xlErrorBarTypeCustom, _
　　　　　　　　　　　Amount:="'" & ws.Name & "'!maxA", _
　　　　　　　　　　　MinusValues:="'" & ws.Name & "'!maxA"
　　　　　　.ErrorBar Direction:=xlY, _
　　　　　　　　　　　Include:=xlBoth, _
　　　　　　　　　　　Type:=xlErrorBarTypeCustom, _
　　　　　　　　　　　Amount:="'" & ws.Name & "'!maxB", _
　　　　　　　　　　　MinusValues:="'" & ws.Name & "'!maxB"
　　　　　　'誤差範囲の線スタイル設定
　　　　　　With .ErrorBars
　　　　　　　　.EndStyle = xlNoCap
　　　　　　　　With .Border
　　　　　　　　　　.LineStyle = xlDash
　　　　　　　　　　.Color = RGB(0, 255, 0) '緑
　　　　　　　　End With
　　　　　　　　'x誤差範囲線の色変更
　　　　　　　　.Format.Line.ForeColor.RGB = RGB(255, 0, 0) '赤
　　　　　　End With
　　　　End With
　　　　'系列1を折れ線Chartに変更
　　　　.SeriesCollection(1).ChartType = xlLine
　　　　'軸のMin,Max設定
　　　　With .Axes(xlValue)
　　　　　　.MinimumScale = Application.Min(r.Columns(2), 0)
　　　　　　.MaximumScale = Application.Ceiling( _
　　　　　　　　　　　　　　Application.Max(r.Columns(2)), 10)
　　　　End With
　　　　With .Axes(xlCategory)
　　　　　　.MinimumScale = Application.Min(r.Columns(1))
　　　　　　.MaximumScale = Application.Max(r.Columns(1))
　　　　End With
　　End With

　　Set r = Nothing
　　Set ws = Nothing
End Sub

■xl2000：VBE マウス スクロール

#こちらこそいつも勉強させて頂いてますm(_ _)m
#ふと、思い出し書き。..雑記です。



以前 ■VBE マウス スクロール で2003、2007のVBEコードウィンドウでマウススクロールができるようになった時期について書いてました。
2000についても、2009年8月頃のmoug.netの質問関連で調べた事があります。
その質問者さんが[winXP/xl2000]の環境でした。
2003、2007との共存環境ならvbe6.dllは共通のバージョンになりますので当然スクロール可なのですが、
2000単独環境の場合もちゃんとOfficeUpdateをやっていればスクロールに対応します。（VBEバージョン1024、VBA:Retail 6.5.1024）



現在、Microsoft UpdateではOffice2000は対象外になっていますし、サポートも終了してるのであまり有益な情報ではないですけど、過去ログから掘り出してメモとして置いておく事にします。
（当時、2000は枯れて安定してたイメージがあって、個人的には好きなバージョンでした）

sp3をまだ適用してない場合は
『office2000sp3（リリース日: 2002/11/11）』
http://www.microsoft.com/downloads/details.aspx?FamilyID=5C011C70-47D0-4306-9FA4-8E92D36332FE&displaylang=ja

sp3にアップデイト後は、ここから手動で更新しなければいけないようです。
http://office.microsoft.com/ja-jp/downloads/CD010225771041.aspx

（念のためここで検索チェックしてもいいかもしれません）
http://www.microsoft.com/japan/technet/security/current.aspx



以前、2000を再インストールする必要があった時に地道にチェックしつつやってみたところ、
『KB944425（リリース日: 2008/02/13）』にVBEスクロール対応が含まれていたようです。
http://www.microsoft.com/downloads/details.aspx?familyid=5fb74e24-d9ee-4951-9c46-e1c84617f097&displaylang=ja

■続々）ADOのメモリリーク

そう言えばずっと気になってて検証せねばと思いつつ忘れてた。
リンクを貼って頂いてた『守破離でいこう!!』様の記事にMicrosoft.ACE.OLEDB.12.0プロバイダを使うとメモリリークしないというコメントがあったのだった。
WinXP/Excel2003の環境に、[2007 Office system ドライバ: データ接続コンポーネント]をダウンロードして試してみた。
（Office2007インストール済み環境では不要）
手順は
・新規Book作成、名前をつけて保存。
・過去記事の Private Sub test_PRE()を新規Bookにコピーして実行。
・以下コードコピーして Sub memLeaktest() 実行。
・■TESTプロシージャ 箇所で ADOtest1 と ADOtest2 をそれぞれ試行してみる。

Option Explicit
'Performance monitor functions for Visual Basic from PDH.DLL
Private Declare Function PdhVbOpenQuery _
　　　　　　　　　　　　　Lib "pdh.dll" ( _
　　　　　　　　　　　　　　　ByRef QueryHandle As Long) As Long
Private Declare Function PdhCloseQuery _
　　　　　　　　　　　　　Lib "pdh.dll" ( _
　　　　　　　　　　　　　　　ByVal QueryHandle As Long) As Long
Private Declare Function PdhVbAddCounter _
　　　　　　　　　　　　　Lib "pdh.dll" ( _
　　　　　　　　　　　　　　　ByVal QueryHandle As Long, _
　　　　　　　　　　　　　　　ByVal CounterPath As String, _
　　　　　　　　　　　　　　　ByRef CounterHandle As Long) As Long
Private Declare Function PdhRemoveCounter _
　　　　　　　　　　　　　Lib "pdh.dll" ( _
　　　　　　　　　　　　　　　ByVal CounterHandle As Long) As Long
Private Declare Function PdhCollectQueryData _
　　　　　　　　　　　　　Lib "pdh.dll" ( _
　　　　　　　　　　　　　　　ByVal QueryHandle As Long) As Long
Private Declare Function PdhVbGetDoubleCounterValue _
　　　　　　　　　　　　　Lib "pdh.dll" ( _
　　　　　　　　　　　　　　　ByVal CounterHandle As Long, _
　　　　　　　　　　　　　　　ByRef CounterStatus As Long) As Double
'-------------------------------------------------
Sub memLeaktest()
　　Const tx As Long = 30 'テスト回数
　　Const wkSQL = "SELECT * FROM [data$]"
　　Const cPath = "¥Process(Excel)¥Private Bytes"
　　Dim ws　　　As Worksheet
　　Dim rng　　 As Range
　　Dim wkBook　As String
　　Dim hPDHQry As Long　 'Handle to performance monitor query
　　Dim hPDHCnt As Long　 'Handle to performance monitor counter
　　Dim cStat　 As Long　 'Status of counter when checked
　　Dim pByts　 As Double 'Value of counter when checked
　　Dim x　　　 As Long
　　Dim i　　　 As Long
　　Dim ret(0 To tx)

　　With ThisWorkbook
　　　　Set ws = .Sheets("out")
　　　　Set rng = .Sheets("data").Range("A2")
　　　　wkBook = .FullName
　　End With
　　x = PdhVbOpenQuery(hPDHQry)
　　x = PdhVbAddCounter(hPDHQry, cPath, hPDHCnt)
　　x = PdhCollectQueryData(hPDHQry)
　　pByts = PdhVbGetDoubleCounterValue(hPDHCnt, cStat)
　　If cStat = 0 Then
　　　　ret(0) = CLng(pByts) ¥ 1024
　　End If

　　For i = 1 To tx
　　　　rng.Value = "'" & i

　　　　'■TESTプロシージャ
　　　　Call ADOtest1(ws, wkBook, wkSQL)

　　　　x = PdhCollectQueryData(hPDHQry)
　　　　pByts = PdhVbGetDoubleCounterValue(hPDHCnt, cStat)
　　　　If cStat = 0 Then
　　　　　　ret(i) = CLng(pByts) ¥ 1024
　　　　End If
　　　　'念のため更新されている事の確認用
　　　　'Debug.Print ws.Cells(1).Value
　　Next

　　x = PdhRemoveCounter(hPDHCnt)
　　x = PdhCloseQuery(hPDHQry)
　　ThisWorkbook.Sheets("chk").Range("IV2").End(xlToLeft) _
　　　　　　　　.Offset(, 1).Resize(tx + 1).Value _
　　　　　　　　= Application.Transpose(ret)

　　Set rng = Nothing
　　Set ws = Nothing
End Sub
'-------------------------------------------------
Sub ADOtest1(ByRef ws As Worksheet, _
　　　　　　ByVal wkBook As String, _
　　　　　　ByVal wkSQL As String)
　　Dim wkCon As Object 'ADODB.Connection
　　Dim wkRst As Object 'ADODB.Recordset

　　On Error GoTo conErr
　　ws.UsedRange.ClearContents
　　Set wkCon = CreateObject("ADODB.Connection")
　　With wkCon
　　　　.Provider = "Microsoft.Jet.OLEDB.4.0"
　　　　.Properties("Extended Properties") = "Excel 8.0"
　　　　.Properties("Data Source") = wkBook
　　　　.Open
　　End With
　　On Error GoTo rsErr
　　Set wkRst = CreateObject("ADODB.Recordset")
　　wkRst.Open wkSQL, wkCon
　　ws.Range("A1").CopyFromRecordset wkRst
　　wkRst.Close
rsErr:
　　wkCon.Close
conErr:
　　Set wkRst = Nothing
　　Set wkCon = Nothing
　　With Err()
　　　　If .Number <> 0 Then
　　　　　　Debug.Print .Number, .Description
　　　　End If
　　End With
End Sub
'-------------------------------------------------
Sub ADOtest2(ByRef ws As Worksheet, _
　　　　　　 ByVal wkBook As String, _
　　　　　　 ByVal wkSQL As String)
　　Dim wkCon As Object 'ADODB.Connection
　　Dim wkRst As Object 'ADODB.Recordset

　　On Error GoTo conErr
　　ws.UsedRange.ClearContents
　　Set wkCon = CreateObject("ADODB.Connection")
　　With wkCon
　　　　.Provider = "Microsoft.ACE.OLEDB.12.0"
　　　　.Properties("Extended Properties") = "Excel 12.0"
　　　　.Properties("Data Source") = wkBook
　　　　.Open
　　End With
　　On Error GoTo rsErr
　　Set wkRst = CreateObject("ADODB.Recordset")
　　wkRst.Open wkSQL, wkCon
　　ws.Range("A1").CopyFromRecordset wkRst
　　wkRst.Close
rsErr:
　　wkCon.Close
conErr:
　　Set wkRst = Nothing
　　Set wkCon = Nothing
　　With Err()
　　　　If .Number <> 0 Then
　　　　　　Debug.Print .Number, .Description
　　　　End If
　　End With
End Sub

結果です。（テスト間はExcel再起動）

確かにメモリリークは解消されてるようです。

■xl2007：SetFirstPriorityメソッド（その後

懺悔シリーズ。

■xl2007：SetFirstPriorityメソッド
この記事では、2007の[条件付き書式]に関して、[適用先]のセル範囲が条件ごとに違う場合、コピーによって優先順位がひっくり返ってしまうので、SetFirstPriorityメソッドを使って設定し直したほうが良い...
...などとホザいてやがる。

うそでした。ごめんなさいorz

追加検証する機会があったので訂正しておきます。
まず前記事のおさらい。

優先順位　適用先　　　ルール　背景色
１　　　　Ａ１：Ｃ１　＞２　　　緑
２　　　　Ａ１：Ｂ１　＞１　　　黄
３　　　　Ａ１　　　　＞０　　　青

こんな[条件付き書式]を設定してコピーすると、優先順位が逆転してるように見えます。

Sub test1()
　　With Sheets.Add
　　　　'A1:C1に条件1
　　　　.Range("A1:C1").FormatConditions.Add( _
　　　　　　　　　　　　Type:=xlExpression, Formula1:="=RC>2" _
　　　　　　　　　　　　).Interior.ColorIndex = 35
　　　　'A1:B1に条件2
　　　　.Range("A1:B1").FormatConditions.Add( _
　　　　　　　　　　　　Type:=xlExpression, Formula1:="=RC>1" _
　　　　　　　　　　　　).Interior.ColorIndex = 36
　　　　'A1に条件3
　　　　.Range("A1").FormatConditions.Add( _
　　　　　　　　　　 Type:=xlExpression, Formula1:="=RC>0" _
　　　　　　　　　　 ).Interior.ColorIndex = 37
　　　　.Range("A1").Value = 3
　　　　.Range("A1:C1").Copy .Range("A2")
　　End With
End Sub

（test1結果）


優先順位　適用先　　　ルール　背景色
１　　　　Ａ２　　　　＞０　　　青
２　　　　Ａ２：Ｂ２　＞１　　　黄
３　　　　Ａ２：Ｃ２　＞２　　　緑

この結果から、単純にSetFirstPriorityメソッドで優先順位をひっくり返せばいいかというと、
ダメです。
同じ[条件付き書式]を、追加する順番を変えてみます。
追加後にPriorityを変更したものを、コピーします。

優先順位　適用先　　　ルール　背景色
３　　　　Ａ１　　　　＞０　　　青
２　　　　Ａ１：Ｂ１　＞１　　　黄
１　　　　Ａ１：Ｃ１　＞２　　　緑

Sub test2()
　　With Sheets.Add
　　　　'A1に条件3
　　　　.Range("A1").FormatConditions.Add( _
　　　　　　　　　　 Type:=xlExpression, Formula1:="=RC>0" _
　　　　　　　　　　 ).Interior.ColorIndex = 37
　　　　'A1:B1に条件2
　　　　With .Range("A1:B1").FormatConditions.Add( _
　　　　　　　　　　　　　　 Type:=xlExpression, Formula1:="=RC>1")
　　　　　　.Interior.ColorIndex = 36
　　　　　　.SetFirstPriority '●
　　　　End With
　　　　'A1:C1に条件1
　　　　With .Range("A1:C1").FormatConditions.Add( _
　　　　　　　　　　　　　　 Type:=xlExpression, Formula1:="=RC>2")
　　　　　　　　.Interior.ColorIndex = 35
　　　　　　　　.SetFirstPriority '●
　　　　End With
　　　　.Range("A1").Value = 3
　　　　.Range("A1:C1").Copy .Range("A2")
　　End With
End Sub

（test2結果）


優先順位　適用先　　　ルール　背景色
１　　　　Ａ２：Ｃ２　＞２　　　緑
２　　　　Ａ２：Ｂ２　＞１　　　黄
３　　　　Ａ２　　　　＞０　　　青

こんな結果。なんと優先順位は変わってません。

もう１つ。

優先順位　適用先　　　ルール　背景色
１　　　　Ａ１：Ｃ１　＞２　　　緑
２　　　　Ａ１　　　　＞１　　　黄
３　　　　Ａ１　　　　＞０　　　青

適用先が同じ範囲である条件と、適用先が違う条件とが混在する場合。

Sub test3()
　　With Sheets.Add
　　　　'A1:C1に条件1
　　　　.Range("A1:C1").FormatConditions.Add( _
　　　　　　　　　　　　Type:=xlExpression, Formula1:="=RC>2" _
　　　　　　　　　　　　).Interior.ColorIndex = 35
　　　　'●A1に条件2
　　　　.Range("A1").FormatConditions.Add( _
　　　　　　　　　　 Type:=xlExpression, Formula1:="=RC>1" _
　　　　　　　　　　 ).Interior.ColorIndex = 36
　　　　'A1に条件3
　　　　.Range("A1").FormatConditions.Add( _
　　　　　　　　　　 Type:=xlExpression, Formula1:="=RC>0" _
　　　　　　　　　　 ).Interior.ColorIndex = 37
　　　　.Range("A1").Value = 3
　　　　.Range("A1:C1").Copy .Range("A2")
　　End With
End Sub

（test3結果）


優先順位　適用先　　　ルール　背景色
１　　　　Ａ２　　　　＞１　　　黄
２　　　　Ａ２　　　　＞０　　　青
３　　　　Ａ２：Ｃ２　＞２　　　緑

こんな結果です。
Ａ１に設定された２つの[条件付き書式]は適用先が違うわけではないので逆転しません。


2007の FormatConditions は、Add の順番、いわゆる作成時の Index を保持していると思われます。
[適用先]のセル範囲が条件ごとに違う[条件付き書式]設定をコピーすると、
FormatConditions 作成時の Index が逆転してしまいます。

Priority が逆転するわけではなかったんですね。
※逆転するのは[適用先]のセル範囲が違う条件のみ。それに１度コピーして逆順になったらそのまま。２回コピーしても戻りません。

#なんともややこしいバグです。 :P