始めてみた

なにか新しいことを始めるとき，モチベーション維持するためのBlog．

Excel VBA #004

VBA プログラミング

ページ数取得

Sub GetNSheetsNPages()
    Dim root As String, target As String, files As String, msg As String, filePath As String
    Dim wb As Workbook, ws As Worksheet
    Dim nSheets As Integer, nPages As Integer, wbPage As Integer
    nSheets = 0
    nPages = 0
    root = ActiveWorkbook.Path
    target = ".\dir01\"
    files = Dir(root & target & "*.xlsx", vbNormal)
    Do While files <> ""
        msg = msg & files & vbCrLf
        filePath = root & target & files
        ' open workbook
        Set wb = Application.Workbooks.Open(filePath)
        wb.Activate
        ' access each worksheet contained in wookbook
        For Each ws In wb.Worksheets
            ActiveWindow.View = xlPageBreakPreview '改ページプレビュー
            'Debug.Print ws.name; " : " & ws.PageSetup.Pages.count 'Excel 2007以降に対応
            nPages = nPages + ws.PageSetup.Pages.count 'Excel 2007以降に対応
            nSheets = nSheets + 1
        Next
        wb.Close False
        files = Dir()
    Loop
    MsgBox msg _
    & vbCrLf & "nSheets : " & nSheets _
    & vbCrLf & "nPages : " & nPages
End Sub

'Private Function PrintPage(ws As Worksheet) As Long
'     Dim H_Break As Integer, V_Break As Integer, P_Page As Integer
'     H_Break = ws.HPageBreaks.count    '横の改ページ数取得
'     V_Break = ws.VPageBreaks.count    '縦の改ページ数取得
'    ' 改ページによりページ数をカウント
'     If V_Break = 0 Then
'         P_Page = H_Break + 1
'     Else
'       H_Break = H_Break + 1
'       V_Break = V_Break + 1
'       P_Page = H_Break * V_Break
'     End If
'     PrintPage = P_Page
'     Dim name As String
'     name = ws.name
'     Debug.Print name & " : " & H_Break & ":" & V_Break & ":" & P_Page
'End Function

Excel VBA #003

プログラミング VBA

ArrayList (Collection)

VBで使えるArrayListクラスモジュール

Option Explicit

Private arraylist As Object
Private Sub Class_Initialize()
'コンストラクタ
    'Debug.Print "Class_Initialize"
    Set arraylist = CreateObject("System.Collections.ArrayList") '.NET Framework
End Sub

Private Sub Class_Terminated()
'デストラクタ
    'Debug.Print "Class_Terminated"
    Set arraylist = Nothing
End Sub

Function Add(ByVal value As Variant) As Integer
'挿入された添字を返す
    Add = arraylist.Add(value)
End Function

Sub Clear()
'要素全消去
    arraylist.Clear
End Sub

Function Contains(ByVal Item As Variant) As Boolean
'要素の存在チェック
    Contains = arraylist.Contains(Item)
End Function

Function IndexOf(ByVal value As Variant, _
                    Optional startIndex As Integer = -1, _
                    Optional count As Integer = 0) As Integer
    Dim rtn As Integer
'【最初に】見つけた一致する要素のIndexを取得
'startIndex：（オプション引数）指定したIndexから探索。指定したIndexを０番目として、最初に見つけた添字の番号を取得
    If startIndex < 0 Then
        rtn = arraylist.IndexOf_3(value)
    Else
        If count < 1 Then
            rtn = arraylist.IndexOf(value, startIndex)
        Else
            rtn = arraylist.IndexOf_2(value, startIndex, count)
        End If
    End If
    IndexOf = rtn
End Function


Sub Insert(ByVal index As Integer, ByVal value As Variant)
'Indexで指定された要素を、Valueに書き換える
    arraylist.Insert index, value
End Sub

Function LastIndexOf(ByVal value As Variant, _
                Optional ByVal startIndex As Integer = -1, _
                Optional ByVal count As Integer = 0) As Integer
'【最後に】見つけた一致する要素のIndexを取得
'startIndex：（オプション引数）指定したIndexから探索。指定したIndexを０番目として、【最後に】見つけた添字の番号を取得
    Dim rtn As Integer
    If startIndex < 0 Then
        rtn = arraylist.LastIndexOf(value)
    Else
        If count < 1 Then
            rtn = arraylist.LastIndexOf(value, startIndex)
        Else
            rtn = arraylist.LastIndexOf(value, startIndex, count)
        End If
    End If
    LastIndexOf = rtn
End Function


Sub Remove(ByVal obj As Variant)
'最初に出現するobjを削除
    arraylist.Remove (obj)
End Sub

Sub RemoveAt(ByVal index As Integer)
'指定されたIndexにある要素を削除
    arraylist.RemoveAt (index)
End Sub

Sub Reverse()
'逆順に整列
    arraylist.Reverse
End Sub

Sub Sort(Optional ByVal comparer As Integer = 0)
'要素の昇順ソートを行う
    arraylist.Sort
End Sub

Function ToArray() As Variant
    ToArray = arraylist.ToArray
End Function

Function ToString() As String
    ToString = arraylist.ToString
End Function

Sub TrinToSize()
'容量を実際の要素数に設定する（これ以上追加しない時、要素削除の後などに実行することでメモリ節約）
    arraylist.TrimToSize
End Sub

Property Get Item(ByVal index As Integer) As Variant
'指定したIndexに格納されている要素を取得
    If IsObject(arraylist.Item(index)) Then
        Set Item = arraylist.Item(index)
    Else
        Item = arraylist.Item(index)
    End If
End Property

Property Let Item(ByVal index As Integer, ByVal value As Variant)
'Insert()メソッドと同様
    arraylist(index) = value
End Property

Property Set Item(ByVal index As Integer, ByVal value As Variant)
'Insert()メソッドと同様
    Set arraylist(index) = value
End Property

Property Get capacity() As Integer
'ArrayListの容量を取得
    capacity = arraylist.capacity
End Property

Property Let capacity(ByVal value As Integer)
'ArrayListの容量を設定
    arraylist.capacity = value
End Property

Property Get count() As Integer
'ArrayListの要素数を取得
    count = arraylist.count
End Property

サンプル、サブプロシージャ

Public Sub DemoMyArrayList()
    Dim list As myArrayList
    Set list = New myArrayList
    'add item
    For itr = 0 To 9
        list.Add ("value : " & itr)
    Next
    
    'reverse and print item
    list.Reverse
    For itr = 0 To 9
        Debug.Print list.Item(itr)
    Next
    'delete item
    Debug.Print "#containars : " & list.count
    list.Remove ("value : 9")
    Debug.Print "#containars : " & list.count
    'refresh capacity
    Debug.Print "==refresh capacity=="
    Debug.Print "capacity : " & list.capacity
    list.TrinToSize
    Debug.Print "capacity : " & list.capacity
    
   ' add new value
    list.Add ("value : 10")
    Debug.Print list.Item(9)
    Debug.Print "#containars : " & list.count
    Debug.Print "capacity : " & list.capacity
    
    'print item
    Debug.Print "==print item=="
    For itr = 0 To 9
        Debug.Print list.Item(itr)
    Next
    
    'sort and print item
    Debug.Print "==sort and print item=="
    list.Sort
    For itr = 0 To 9
        Debug.Print list.Item(itr)
    Next
    
End Sub