MSFlexGrid/MSHFlexGrid で列幅自動設定/行の高さ自動設定(VB6.0)

　下記プログラムコードに関する補足・注意事項　
動作確認：Windows Vista・Windows 7 (32bit) / VB6.0(SP6)
Option　：[Option Explicit]
参照設定：
使用 API：GetDoubleClickTime / timeGetTime
その他　：プロジェクト→コンポーネント→コントロールで Microsoft FlexGrid Control 6.0(SP6) 又は、
　　　　：Microsoft Hierarchical FlexGridにチェックを入れ、表示されたコントロールをフォームに貼り付けて下さい。
　　　　：尚、当サイトで掲載している MSFlexGrid / MSFlexGrid 関係のサンプルは、上記と同様とし、今後は省略します。

１．MSFlexGrid / MSHFlexGrid でワードラップ時に行の高さを自動的に調整する

以前、掲載していた方法
　MSFlexGridでワードラップ時に行の高さを自動調整
　APIを使った同様のサンプル
　Microsoft サポート技術情報に掲載されている方法
では、処理に時間がかかり過ぎ(66.5 秒/１万行×8列)、データ件数が多い場合、使い物にならないので、処理速度に拘った方法を掲載しました。

準備事項
　　下記のような Label を Form の見えない位置にでも配置しておいて下さい。(Label 名は、lblGetCellHeight に)
　　With lblGetCellHeight　 'ラベルを見えない位置に配置
　　　　.AutoSize = True
　　　　.WordWrap = True
　　　　.Visible = False
　　End With

テスト環境の設定
　　注意　MSHFlexGrid の場合、列幅が標準のままの場合、ColWidth は -1 になりますので、事前に設定しておいて下さい。
　　Dim i As Long
　　With MSHFlexGrid1
　　　　For i = 0 To .ColS - 1
　　　　　　.ColWidth(i) = 900　'すでに列幅が変更されていれば必要ありません。
　　　　Next i
　　　　.ColWidth(3) = 700　'列幅を変更して折り返して表示されるように設定
　　　　.WordWrap = True
　　　　.TextMatrix(2, 3) = "ABC4567890123456789012ABC"　　 '注意　WordWrap が有効にならない
　　　　.TextMatrix(3, 3) = "ABC456 7890123456 789012ABC"
　　　　.TextMatrix(4, 3) = "ABC45678901" & vbCrLf & "2345678901234"
　　　　.TextMatrix(5, 3) = "あああああああああああ"
　　　　.TextMatrix(7, 3) = "いいいいいいいいいいいいいいいい"
　　End With

　１万行×8列 のサンプルデータを表示し、上記のようなテスト環境の状態で

下記には、条件があります、セル個別にフォントに関する設定がされていない事。

Private Sub Command3_Click()
　　'全ての列に対して折り返して表示しているはずがないので一番行の高さが高くなるであろうと思う列を指定する
　　Call sAutoCellHeight(3, 3)　　　
End Sub

Private Sub sAutoCellHeight(ByVal CoS As Long, ByVal CoE As Long)
　　Dim i As Long, j As Long　　'ループ用のカウンター
　　Dim TxtHeight As Long　　　 '文字の高さ
　　Dim NewHeight As Long　　　 '変更後のセルの高さ
　　With MSHFlexGrid1
　　　　.Redraw = False　　　　 '再描画を抑制
　　　　.Row = .FixedRows　　　'基準のフォントサイズ等を取得する行
　　　　.Col = CoS　　　　　　　'基準のフォントサイズ等を取得する列
　　　　'全てのセルのフォントサイズ等が同じと仮定して
　　　　lblGetCellHeight.FontSize = .CellFontSize
　　　　lblGetCellHeight.FontName = .CellFontName
　　　　lblGetCellHeight.FontBold = .CellFontBold
　　　　lblGetCellHeight.FontItalic = .CellFontItalic
　　　　For i = 0 To .Rows - 1
　　　　　　NewHeight = 0
　　　　　　'全ての列に対して折り返して表示しているはずがないので
　　　　　　For j = CoS To CoE　　　　　　　　　　　　　　　　　'その行内で一番高いセルを取得
　　　　　　　　lblGetCellHeight.Width = .ColWidth(j) - 90　　　'ラベルの幅と列幅を同じに
　　　　　　　　lblGetCellHeight.Caption = .TextMatrix(i, j)　　'ラベルに文字列を設定して高さを取得
　　　　　　　　TxtHeight = lblGetCellHeight.Height　　　　　　 '折返しを含めた高さを取得
　　　　　　　　If NewHeight < TxtHeight Then
　　　　　　　　　　NewHeight = TxtHeight　　　　　　　　　　　 '行内で一番高いセルの高さを取得
　　　　　　　　End If
　　　　　　Next j
　　　　　　.RowHeight(i) = NewHeight + 40　　　　　　　　　　　'余白分をプラスして設定
　　　　Next i

　　　　.Col = 0　　　　'ホームポジションへ移動
　　　　.Row = 0
　　　　.Redraw = True　'再描画を再開
　　End With
End Sub

全ての行の高さを標準の設定に戻す場合
Private Sub Command4_Click()
'標準の高さに設定
　　MSHFlexGrid1.RowHeight(-1) = -1
End Sub

66.5 秒/１万行×8列 かかっていたのが、1.06 秒で、できました。Call sAutoCellHeight(1, 3) で、3.8 秒です。

２．MSFlexGrid / MSHFlexGrid で列幅を文字列長に合わせて自動的に調整する

Private Sub Command3_Click()
　　'行の高さの設定と同様の条件とします。
　　'同じLabel を使っております。WordWrap = False に変更して下さい。(実使用時には、Label 名を変更を)
　　With lblGetCellHeight　 'ラベルを見えない位置に配置
　　　　.AutoSize = True
　　　　.WordWrap = False
　　　　.Visible = False
　　End With

　　Dim i As Long
　　For i = 0 To 7　　　　　　　
　　　　'列個別に設定できるようにしておりますので、必要に応じてループで設定を
　　　　Call sAutoColWidth(i)
　　Next i
End Sub

Private Sub sAutoColWidth(ByVal CoS As Long)
　　Dim i As Long, j As Long　　'ループ用のカウンター
　　Dim TxtWidth As Long　　　　'文字の高さ
　　Dim NewWidth As Long　　　　'変更後のセルの高さ
　　With MSHFlexGrid1
　　　　.Redraw = False　　　　 '再描画を抑制
　　　　.Row = .FixedRows　　　 '基準のフォントサイズ等を取得する行
　　　　.Col = CoS　　　　　　　'基準のフォントサイズ等を取得する列
　　　　'全てのセルのフォントサイズ等が同じと仮定して
　　　　lblGetCellHeight.FontSize = .CellFontSize
　　　　lblGetCellHeight.FontName = .CellFontName
　　　　lblGetCellHeight.FontBold = .CellFontBold
　　　　lblGetCellHeight.FontItalic = .CellFontItalic
　　　　NewWidth = 0
　　　　For i = 0 To .Rows - 1
　　　　　　lblGetCellHeight.Caption = .TextMatrix(i, CoS)　'ラベルに文字列を設定して高さを取得
　　　　　　TxtWidth = lblGetCellHeight.Width　　　　　　　 '折返しを含めた高さを取得
　　　　　　If NewWidth < TxtWidth Then
　　　　　　　　NewWidth = TxtWidth　　　　　　　　　　　　 '行内で一番高いセルの高さを取得
　　　　　　End If
　　　　Next i
　　　　.ColWidth(CoS) = NewWidth + 90
　　　　.Col = 0　　　　'ホームポジションへ移動
　　　　.Row = 0
　　　　.Redraw = True　'再描画を再開
　　End With
End Sub

行の高さの設定のコードを流用して列幅用に作り直したので、変数名等は変更して下さい。
8列設定しても 3.7 秒程度です。1万行/1列なら 0.3 秒程度です。

３．MSFlexGrid / MSHFlexGrid で Excel のようにセルの境界線をダブルクリックする事で列幅を設定

MSFlexGrid / MSHFlexGrid の列幅を Excel のようにセルの境界線をダブルクリックする事で自動的にセルの文字列の幅に合せてセル幅を設定する
通常は境界線上ではクリックイベントが発生しない事を逆手に取って、イベントを取得している。

Option Explicit

'マウスのダブルクリックの間隔を取得する(P1042)
Private Declare Function GetDoubleClickTime Lib "user32" () As Long
'システムを立ち上げてからの経過時間を高精度に取得する
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private blnBoundaryClick As Boolean

Private Sub MSHFlexGrid1_Click()
　　'MouseUpイベント後に発生
　　'境界線上ではクリックイベントが発生しない
　　blnBoundaryClick = True
　　'ダブルクリックを感知する
　　Dim St As Long
　　'マウスのダブルクリックの間隔を考慮(0.18~0.9)
　　St = timeGetTime + GetDoubleClickTime
　　'APIを使用しないなら0.18~0.9秒の範囲で待機して下さい。
　　Do While timeGetTime < St
　　　　'timeGetTimeがリセットされた場合
　　　　If St - timeGetTime > 2000 Then St = 0
　　　　DoEvents
　　Loop
　　'通常のダブルクリックイベントの時は、MSFlexGrid1_DblClick の方が先に発生する。
　　blnBoundaryClick = False
End Sub

Private Sub MSHFlexGrid1_DblClick()
　　'境界線の部分がダブルクリックされた
　　Debug.Print blnBoundaryClick　　'ダブルクリックイベントの時確認すれば理解できるかと
　　If blnBoundaryClick = False Then
　　　　Call sAutoColWidth(MSHFlexGrid1.MouseCol)
　　End If
End Sub

４．

５．

６．

検索キーワード及びサンプルコードの別名(機能名)

MSHFlexGrid で列幅自動設定　MSHFlexGrid で行の高さ自動設定　エクセルのように　境界線をダブルクリック　境界線をクリックした時のイベント / ワードラップ時にの行数
MSFlexGrid で列幅自動設定　MSFlexGrid で行の高さ自動設定　境界線をクリックして列幅を設定　文字列の長さに合わせて　文字列の行数に応じて　ワードラップ時
MSHFlexGrid で列幅を文字列長に合わせて自動設定　文字列の幅に合わせて列幅を設定　セルとセルの間をクリック　ダブルクリックイベントを取得　列の幅　行の高さ

VBレスキュー(花ちゃん)

Visual Basic 6.0