2024/10/22

Notes - Excel 連携：#43）作業前のコードの確認

前回は PlotArea のプロパティについて調査しましたので、今回からはその設定を行うコーディングを始めます。

今回以降の作業は『#18）グラフの目盛線』のプログラムをベースに行います。ただ、その記事から期間が空いていること、連載が長くなっていることから、いったん全体のコードを掲載します。

今回は、作業のスタート地点の確認だけの記事です。ご了承ください。


設計要素としては、エージェントとスクリプトライブラリとなります。


エージェント

内容は #18 と同じですが、#25 でスクリプトライブラリ名を lsXls に変更したので、その点だけ修正しています。

Option Declare
Use "lsXls"

Sub Initialize
   Dim oXls As Variant
   Dim oSheet As Variant
   Dim oShape As Variant
   Dim oChart As Variant

   'Excel の準備
   Set oXls = CreateObject("Excel.Application")
   Call oXls.Workbooks.Add
   Set oSheet = oXls.Workbooks(1).WorkSheets(1)

   'サンプルデータのセット
   Call xSetSampleData(oSheet)

   'グラフの作成
   Set oShape = oSheet.Shapes.AddChart2(, 4, 200, 1, 500, 200)
   Set oChart = oShape.Chart

   'データソースの指定
   Call oChart.SetSourceData(oSheet.Range("A:A, B:B"))

   'タイトルのセット
   oChart.ChartTitle.Text = "ユーザ数の推移"

   'Y 軸の設定
   oChart.Axes(xlValue).MinimumScale = 500
   oChart.Axes(xlValue).MaximumScale = 2000
   oChart.Axes(xlValue).MajorUnit = 500

   'X 軸の設定
   oChart.Axes(xlCategory).CategoryType = xlTimeScale
   oChart.Axes(xlCategory).MajorUnit = 7
   oChart.Axes(xlCategory).TickLabels.NumberFormatLocal = "m/d;@"

   '目盛線の追加
   Call oChart.SetElement(msoCategoryGridLinesMajor)
   Call oChart.SetElement(msoValueGridLinesMinorMajor)
   Call oChart.SetElement(msoCategoryGridLinesMinorMajor)

   'Y 軸補助目盛線の設定
   oChart.Axes(xlValue).MinorUnit = 250
  
   oXls.Visible = True
End Sub

Function xSetSampleData(voSheet As Variant)
   Dim i As Integer
   Dim vDT As Variant
   Dim iUsr As Integer
   Dim iVal As Integer
   Dim iMax As Integer

   '列フォーマットの設定
   voSheet.Columns(1).NumberFormatLocal = "yyyy/m/d"
   voSheet.Columns(2).NumberFormatLocal = "#,##0_ "
   voSheet.Columns(3).NumberFormatLocal = "#,##0_ "

   'ヘッダ行のフォーマット設定
   voSheet.Rows(1).NumberFormatLocal = "@"

   'カラム名称の設定（ヘッダ行）
   voSheet.Cells(1, 1).Value = "日付"
   voSheet.Cells(1, 2).Value = "ユーザ数"
   voSheet.Cells(1, 3).Value = "増減"

   'サンプルデータの設定
   Randomize
   iMax = 30
   vDT = Today - iMax
   iUsr = 1000

   For i = 2 To iMax + 1
      vDT = vDT + 1
      iVal = Int(Rnd()*100) - 30
      iUsr = iUsr + iVal
      voSheet.Cells(i, 1).Value = vDT
      voSheet.Cells(i, 2).Value = iUsr
      voSheet.Cells(i, 3).Value = iVal
   Next
End Function


スクリプトライブラリ

スクリプトライブラリ lsXls は #18 より後に掲載した内容も含め、現時点での最新の状態としています。少し長くなりますが、下記の通りです。

Option Declare

'XlAxisType 列挙 (Excel)
Public Const xlCategory = 1
Public Const xlValue = 2

'XlCategoryType 列挙 (Excel)
Public Const xlAutomaticScale = -4105
Public Const xlCategoryScale = 2
Public Const xlTimeScale = 3

'MsoChartElementType 列挙 (Excel)
Public Const msoCategoryGridLinesMajor = 334
Public Const msoValueGridLinesMinorMajor = 331
Public Const msoCategoryGridLinesMinorMajor = 335

'XlBordersIndex 列挙 (Excel)
Public Const xlEdgeLeft = 7 '範囲の左側の罫線
Public Const xlEdgeTop = 8 '範囲の上側の罫線
Public Const xlEdgeBottom = 9 '範囲の下側の罫線
Public Const xlEdgeRight = 10 '範囲の右側の罫線
Public Const xlInsideVertical = 11 '範囲の外側を除くすべての垂直罫線
Public Const xlInsideHorizontal = 12 '範囲の外側を除くすべての水平罫線

'XlBorderWeight 列挙 (Excel)
Public Const xlHairline = 1 '細線 (最も細い罫線)
Public Const xlMedium = -4138 '普通
Public Const xlThin = 2 '極細
Public Const xlThick = 4 '太線 (最も太い罫線)

'XlLineStyle 列挙 (Excel)
Public Const xlContinuous = 1 '実線
Public Const xlDouble = -4119 '2 本線
Public Const xlLineStyleNone = -4142 'なし
Public Const xlDash = -4115 '破線

'XlHAlign 列挙 (Excel)
Public Const xlHAlignLeft = -4131 '左揃え
Public Const xlHAlignCenter = -4108 '中央揃え
Public Const xlHAlignRight = -4152 '右揃え
Public Const xlHAlignGeneral = 1 'データの種類に従って揃える

'XlPaperSize 列挙 (Excel)
Public Const xlPaperA3 = 8
Public Const xlPaperA4 = 9
Public Const xlPaperB4 = 12
Public Const xlPaperB5 = 13

'XlPageOrientation 列挙 (Excel)
Public Const xlPortrait = 1 '縦モード
Public Const xlLandscape = 2 '横モード

'XlFixedFormatType 列挙
Public Const xlTypePDF = 0
Public Const xlTypeXPS = 1

'MsoAutoShapeType 列挙 (Office)
Public Const msoShapeOval = 9 '楕円

'MsoTextOrientation 列挙 (Office)
Public Const msoTextOrientationHorizontal = 1 '横方向

'MsoVerticalAnchor 列挙 (Office)
Public Const msoAnchorMiddle = 3 '垂直方向に中央揃え

'MsoParagraphAlignment 列挙 (Office)
Public Const msoAlignCenter = 2 '中央揃え

Public Function GetRangeString(_
         ByVal viRowFm As Integer, ByVal viColFm As Integer, _
         ByVal viRowTo As Integer, ByVal viColTo As Integer) As String
   Dim s As String

   s = RCToA1(viRowFm, viColFm)
   s = s & ":" & RCToA1(viRowTo, viColTo)

   GetRangeString = s
End Function

Public Function PointToCM(ByVal vdPoint As Single) As Single
   PointToCM = InchToCM(PointToInch(vdPoint))
End Function

Public Function PointToPixcel(ByVal vdPoint As Single) As Integer
   PointToPixcel = CInt(vdPoint / .75)
End Function

Public Function InchToPixcel(ByVal vdInch As Single) As Integer
   InchToPixcel = CInt(vdInch * 96)
End Function

Public Function CMToInch(ByVal vdCM As Double) As Single
   CMToInch = vdCM / 2.54
End Function

Public Function RGB(ByVal vbyR As Byte, ByVal vbyG As Byte, ByVal vbyB As Byte) As Long
   RGB = vbyR + CLng(vbyG) * 256 + CLng(vbyB) * 256 ^ 2
End Function

Public Function InchToPoint(ByVal vdInch As Single) As Single
   InchToPoint = vdInch * 72
End Function

Public Function PixcelToInch(ByVal viPixcel As Integer) As Single
   PixcelToInch = viPixcel / 96
End Function

Public Function PixcelToPoint(ByVal viPixcel As Integer) As Single
   PixcelToPoint = viPixcel * .75
End Function

Function x9ToA(ByVal viColNumber As Integer) As String
   Dim i As Integer
   Dim i1 As Integer
   Dim i2 As Integer
   Dim s As String

   i = viColNumber - 1
   i1 = (i Mod 26) + 1
   i2 = Int(i / 26)

   If i2 > 0 Then s = Chr(64 + i2)
   s = s & Chr(64 + i1)

   x9ToA = s
End Function

Public Function CCToAA(ByVal viColFm As Integer, ByVal viColTo As Integer) As String
   CCToAA = x9ToA(viColFm) & ":" & x9ToA(viColTo)
End Function

Public Function CMToPixcel(ByVal vdCM As Single) As Single
   CMToPixcel = InchToPixcel(CMToInch(vdCM))
End Function

Public Function RCToA1(ByVal viRow As Integer, ByVal viCol As Integer) As String
   RCToA1 = x9ToA(viCol) & CStr(viRow)
End Function

Public Function InchToCM(ByVal vdInch As Single) As Single
   InchToCM = vdInch * 2.54
End Function

Public Function PointToInch(ByVal vdPoint As Single) As Single
   PointToInch = vdPoint / 72
End Function

Public Function PixcelToCM(ByVal viPixcel As Integer) As Single
   PixcelToCM = InchToCM(PixcelToInch(viPixcel))
End Function

Public Function CMToPoint(ByVal vdCM As Single) As Single
   CMToPoint = InchToPoint(CMToInch(vdCM))
End Function


前回 Notes - Excel 連携 次回


時刻:
ラベル: , ,

0 件のコメント:

コメントを投稿

登録: コメントの投稿 (Atom)