■ フレキシブルグリッドの利用 ■ ■ セルに直接データーを入力する 指定セルの内容の直接編集を擬似的に実施する方法は、下記の通りで有る。 ・アクティブセルの上にテキストボックスをセルと同じ大きさで表示 ・Enter キーに依るセルの移動（↓ → 選択可能） ・タブキーに依る移動（← → 選択可能） 以上の設定は、エクセルでのセル内編集と粗同じ動きをする様に設定する物で有る。後は、各自都合の良い様に 機能を改良すると良い。 １．Form に MSFlexGrid とテキストボックスを３個下記の様に貼り付ける。 ２．フォームの宣言セクションに、下記のコードを記述する。 Option Explicit
Private NextCell As Integer ' Enter 入力の後の移動方向の選択 ３．フォームロードイベントに、下記のコードを記述する。
Private Sub Form_Load()
Dim I As Long ' ループ用カウンタ Form1.Move 0, 0, 8640, 4000 ' MSFlexGrid の初期設定 With MSFlexGrid1 .Move 150, 150, 8170, 2850 .Rows = 10 ' 行の総数（固定行含む）
.Cols = 8 ' 列の総数（固定列含む） .FixedRows = 1 ' 固定行の数（Rows より１以上尐ない事） .FixedCols = 1 ' 固定列の数（Cols より１以上尐ない事） .Row = 0 .ColWidth(0) = 430 ' 列幅 .ColWidth(1) = 550 .ColWidth(2) = 1800 For I = 3 To 7 .ColWidth(I) = 1000 Next I .RowHeight(0) = 350 ' 行の高さ ' 固定行セルの項目名を中寄／中寄で表示
.Col = 1: .Text = "Ｎｏ": .CellAlignment = flexAlignCenterCenter .Col = 2: .Text = "氏 名": .CellAlignment = flexAlignCenterCenter .Col = 3: .Text = "国 語": .CellAlignment = flexAlignCenterCenter .Col = 4: .Text = "数 学": .CellAlignment = flexAlignCenterCenter .Col = 5: .Text = "英 語": .CellAlignment = flexAlignCenterCenter .Col = 6: .Text = "合 計": .CellAlignment = flexAlignCenterCenter .Col = 7: .Text = "平均点": .CellAlignment = flexAlignCenterCenter .Col = 0 For I = 1 To .Rows - 1 .RowHeight(I) = 350 ' 行の高さ .Row = I .Text = I ' 行番号を表示 Next I .Col = 1: .Row = 1 .FocusRect = flexFocusNone .HighLight = flexHighlightAlways End With With Text1 .BackColor = &H80FFFF ' 動きが解り易い様に .Text = "" .Visible = False End With End Sub ' MSFlexGrid コントロールからテキストボックスにフォーカスを移動
Private Sub MSFGEdit(MSFlexGrid As Control, Edit As Control, KeyAscii As Integer) ' 入力された文字の使用
Select Case KeyAscii
' 空白は、現在のテキストの編集を示す。 Case 0 To vbKeySpace Edit = MSFlexGrid Edit.SelStart = 1000 '其の他は、現在のテキストを置き換える。 Case Else Edit = Chr$(KeyAscii) Edit.SelStart = 1 End Select ' セルの位置にテキストボックスを表示 With MSFlexGrid
Edit.Move .Left + .CellLeft, .Top + .CellTop, .CellWidth, .CellHeight End With
Edit.Visible = True ' 実行する。 Edit.SetFocus End Sub
' テキストボックスの編集機能のルーチンへ
Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer) Call MSFGEdit(MSFlexGrid1, Text1, KeyAscii)
End Sub
' テキストボックスの編集機能のルーチンへ Private Sub MSFlexGrid1_DblClick()
Call MSFGEdit(MSFlexGrid1, Text1, vbKeySpace) ' 空白を代入する End Sub
４．以上で、一応、入力テキストボックスに入力が可能に成る。引き続き下記のコードを記述する。 ' 改行文字を削除し、警告音が発生し無い様にする。
Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = vbKeyReturn Then
KeyAscii = 0 End If
End Sub
' 入力キーの判定移動処理へ
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) Call EditKeyCode(MSFlexGrid1, Text1, KeyCode)
End Sub
' フォーカスを移動するルーチン
Private Sub EditKeyCode(MSFlexGrid As Control, Edit As Control, KeyCode As Integer) With MSFlexGrid
' 標準の編集コントロールの処理で有る Select Case KeyCode
Case vbKeyEscape ' Esc キーは、非表示にしてフォーカスを MSFlexGrid に戻す。 Edit.Visible = False
.SetFocus
Case vbKeyReturn, vbKeyTab ' Enter と Tab に依るフォーカス移動。 ' ↓移動を選択した場合
If NextCell = 1 Then .SetFocus
DoEvents
If .Row < .Rows - 1 Then ' １つ下に移動 .Row = .Row + 1 End If End If ' →移動を選択の場合（デフォルト） If NextCell = 0 Then .SetFocus DoEvents ' 右端に行った場合の折り返し処理
If .Col = .Cols - 1 And .Row < .Rows - 1 Then .Row = .Row + 1
.Col = 0 End If
' １つ右に移動
If .Col < .Cols - 1 Then .Col = .Col + 1 End If
Case vbKeyUp ' ↑キー。 .SetFocus
DoEvents
If .Row > .FixedRows Then .Row = .Row - 1
End If
Case vbKeyDown ' ↓キー。 .SetFocus
DoEvents
If .Row < .Rows - 1 Then .Row = .Row + 1 End If
End Select End With End Sub
Private Sub MSFlexGrid1_GotFocus() If Text1.Visible = False Then Exit Sub
' セルからフォーカスが移動した時にテキストボックスの ' データーをセルにコピーしテキストボックスを非表示に設定 MSFlexGrid1 = Text1
Text1.Visible = False End Sub
Private Sub MSFlexGrid1_LeaveCell() If Text1.Visible = False Then Exit Sub
' セルからフォーカスが移動した時にテキストボックスの ' データーをセルにコピーしテキストボックスを非表示に設定 MSFlexGrid1 = Text1 Text1.Visible = False End Sub ５．以上で、入力・編集・フォーカス移動が可能と成る。引き続き下記のコードを記述する。 ' 漢字キーが押された状態での入力が出来ない為の処理
Private Sub MSFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode > 127 Or KeyCode = vbKeyF2 Then ' 漢字、及び、F2 キーの場合 Call MSFGEdit(MSFlexGrid1, Text1, vbKeySpace) ' 空白を代入する。
End If End Sub
６．↓移動と→移動のメニューを作成する Private Sub mnuDown_Click()
' Enter 入力の後、下方向に移動（Excel と同様の操作に） NextCell = 1
End Sub
Private Sub mnuRight_Click() ' Enter 入力の後、右方向に移動 NextCell = 0
７．タブキーに依るフォーカス移動の設定を行う。
タブキーでの移動が出来ない為、別途ダミーのテキストボックスを２個、見え無い処に配置して置く。猶、動き
が逆の場合は、TabIndex の番号を入れ替える等の処理を施す。
Private Sub Text2_GotFocus() ' タブキーに依る右移動 With MSFlexGrid1 If .Col < .Cols - 1 Then .Col = .Col + 1
ElseIf .Row < .Rows - 1 Then .Row = .Row + 1 .Col = 1 End If DoEvents .SetFocus End With End Sub
Private Sub Text3_GotFocus() ' シフトキ＋タブキーに依る左移動 With MSFlexGrid1
If .Col > 1 Then .Col = .Col - 1 ElseIf .Row > 1 Then .Row = .Row - 1 .Col = .Cols - 1 End If DoEvents .SetFocus End With End Sub 猶、フォームに色々コントロールが貼り付けて有る場合は旨く動か無い事が有る。別途API を使用した方法を試 す必要が有る。 ■ 各セル個別に ToolTipText を表示する
MSFlexGrid の ToolTipText は１個しか表示する事が出来ない。其処で、MouseMove イベントと配列データー を使用して実現する。
猶、データー部分等は、各自の環境に依り、シーケンシャルファイルで作成し、起動時に配列に読込だりして使 用する。例えば、前回の成績を読込んで置けば、今回の成績と比較が簡単に出来たりする。
Option Explicit
Private TTTShowFlag As Boolean ' ツールチップ表示フラグ（宣言セクションに記入） Private Msg(9, 7) As String ' ツールチップ表示テキスト
Private Form_Load() Dim I As Integer Dim J As Integer ' 表示用データーを作成 For I = 0 To 9 For J = 0 To 7
Msg(I, J) = I & "行目の" & J & "列目のセル" Next J
Next I End Sub
Private Sub Command5_Click() ' フラグ（True 又は False）の設定 TTTShowFlag = Not TTTShowFlag End Sub
Private Sub MSFlexGrid1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) ' MSFlexGrid のセル個別に ToolTipText を設定表示
If TTTShowFlag = True Then Dim R As Integer Dim C As Integer ' マウス位置の読み込み R = MSFlexGrid1.MouseRow C = MSFlexGrid1.MouseCol ' 該当セルとデーターの照合
If MSFlexGrid1.MouseRow = R And MSFlexGrid1.MouseCol = C Then '該当セルに ToolTipText を表示 MSFlexGrid1.ToolTipText = Msg(R, C) End If Else MSFlexGrid1.ToolTipText = "" End If End Sub ■ 複数の任意のデータを任意の場所に貼付け 複数の任意の場所のデータを任意の位置に貼付ける方法は、下記の通りで有る。 ・Ctrl キーを押しクリックした位置のセルを反転色にする。 ・反転色のセルのデータを変数に代入する。 ・貼付け位置を指定し、貼付けボタンをクリックする事で１個宛任意の位置に貼付ける。 但し、此の方法は全部のセルを参照する為、データ数が多いと効率が悪く成る。クリックした位置丈調べる方法 も考えたが、クリックした順番にしか貼付けが出来ず今回の方法に仕た。セル数が5000 位迄なら、此れでも充 分実用的で有る。 下記のコードを、宣言セクションに記述する。 Option Explicit
Dim KeyCtrl As Boolean ' Ctrl キーが押されて居るかの判定 Dim SelDatCount As Long ' セルデータのカウント
Dim MyRow As Long ' Row 位置取得 Dim MyCol As Long ' Col 位置取得
Dim SelCopyCount As Long ' セルへのコピー数のカウント 下記のコードを、各イベントに記述する。
Private Sub Form_Load() Dim i As Long Dim j As Long Dim n As Long ' ダミーのデータを表示 With MSFlexGrid1 .Rows = 15 .Cols = 10 ' 表示を早くする為に一旦非表示に設定 .Visible = False .RowHeight(-1) = 350 ' 固定行は除く
For i = .FixedRows To .Rows - .FixedRows - 8 ' 固定列は除く
For j = .FixedCols To .Cols - .FixedCols - 5 .Col = j .Row = i n = n + 1 .Text = n Next j Next i .Visible = True End With End Sub ' クリックしたセルを強調表示 Private Sub MSFlexGrid1_Click() With MSFlexGrid1
' クリック位置を取得 MyRow = .Row MyCol = .Col
If KeyCtrl = True Then
If .CellBackColor = QBColor(1) Then ' 再クリックした場合セル色を元に .CellBackColor = QBColor(15) .CellForeColor = QBColor(0) Else ' セルに反転色を指定 .CellBackColor = QBColor(1) .CellForeColor = QBColor(15) End If End If End With End Sub ' Ctrl キーの押下げを取得
Private Sub MSFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer) If Shift = vbCtrlMask Then
KeyCtrl = True ' Ctrl キーが押された SelDatCount = 0
Else
KeyCtrl = False End If
End Sub
Private Sub MSFlexGrid1_KeyUp(KeyCode As Integer, Shift As Integer) ' Ctrl キーを放した
If KeyCtrl = True Then KeyCtrl = False If SelDatCount = 0 Then ' データをコピーする SubDatCopy End If End If End Sub ' 強調表示のセルを探し、其のセルの中身を配列に読み込み Private Sub SubDatCopy()
Dim i As Integer Dim j As Integer SelDatCount = 0
ReDim Preserve SelDat(SelDatCount) As Variant ' 表示を早くする為に一旦非表示に設定
With MSFlexGrid1 .Visible = False ' 固定行は除く
For i = .FixedRows To .Rows - .FixedRows ' 固定列は除く
For j = .FixedCols To .Cols - .FixedCols .Col = j
.Row = i
' 反転色のセルを探す
If .CellBackColor = QBColor(1) Then SelDatCount = SelDatCount + 1 ' 配列を１個宛増やす
ReDim Preserve SelDat(SelDatCount) As Variant ' 又はコピー先を指定して直接コピー ' 行の左から右への順に変数に代入 SelDat(SelDatCount) = .Text ' セルの色を元に戻す .CellBackColor = QBColor(15) .CellForeColor = QBColor(1) End If Next j Next i .Visible = True End With End Sub ' クリックされた位置に配列の中身を表示 Private Sub Command1_Click()
' データが無い場合
If SelDatCount = 0 Then Exit Sub ' 貼付け件数をカウント
SelCopyCount = SelCopyCount + 1 If SelCopyCount > SelDatCount Then ' 全部貼り付けた場合
SelDatCount = 0 ReDim SelDat(0) Exit Sub End If With MSFlexGrid1 ' クリック位置に貼付け .Row = MyRow .Col = MyCol .Text = SelDat(SelCopyCount) End With End Sub ■ グリッドに表示出来る行数を取得する スクロールの方法とグリッドに一度に表示する事の出来る最大行数を取得する関数を下記に示す。機能は下記の 通りで有る。 ・グリッドの内容の変更が可能 ・エンターキーでの移動が可能 ・直接文字を入力すると上書きモード ・エンターかマウスのダブルクリックで、挿入モード ・自動でスクロール。
Private Sub Text1_KeyPress(KeyAscii As Integer) Dim Total As Single
Dim Average As Single If KeyAscii = 13 Then KeyAscii = 0
MSFlexGrid1.Text = text1.Text
If MSFlexGrid1.Row = MSFlexGrid1.Rows - 1 And MSFlexGrid1.Col = MSFlexGrid1.Cols - 1 Then ' 最後の行に成れば最初の行へ移動
MSFlexGrid1.Row = MSFlexGrid1.FixedRows MSFlexGrid1.Col = MSFlexGrid1.FixedCols MSFlexGrid1.TopRow = MSFlexGrid1.FixedRows MSFlexGrid1.LeftCol = MSFlexGrid1.FixedCols ElseIf MSFlexGrid1.Col = MSFlexGrid1.Cols - 1 Then ' 次の行の先頭へ折り返す
MSFlexGrid1.Row = MSFlexGrid1.Row + 1 MSFlexGrid1.Col = MSFlexGrid1.FixedCols MSFlexGrid1.LeftCol = MSFlexGrid1.FixedCols
If MSFlexGrid1.Row >= VisibleRows(MSFlexGrid1) Then ' 行のスクロール
MSFlexGrid1.TopRow = MSFlexGrid1.TopRow + 1 End If
Else
If MSFlexGrid1.Col >= VisibleCols(MSFlexGrid1) Then ' 列のスクロール MSFlexGrid1.LeftCol = MSFlexGrid1.LeftCol + 1 End If ' セルを１つ移動 MSFlexGrid1.Col = MSFlexGrid1.Col + 1 text1.Visible = True text1.SetFocus 'MSFlexGrid1.SetFocus
End If MSFlexGrid1.Text = text1.Text text1.Text = "" End If End Sub ' グリッドに一度に表示出来る最大行数を返す。
Public Function VisibleRows(grdName As MSFlexGrid) Dim lngUsingRows As Long
For Cnt_Rows = 0 To grdName.Rows - 1
lngUsingRows = lngUsingRows + grdName.RowHeight(Cnt_Rows)
If grdName.Height <= lngUsingRows Then = Cnt_Rows - grdName.FixedRows - 1 Exit For Else VisibleRows = grdName.Rows End If Next Cnt_Rows End Function ' グリッドに一度に表示出来る最大列数を返す。 Public Function VisibleCols(grdName As MSFlexGrid) Dim lngUsingCols As Long
For Cnt_Cols = 0 To grdName.Cols - 1
lngUsingCols = lngUsingCols + grdName.ColWidth(Cnt_Cols) If grdName.Width <= lngUsingCols Then
VisibleCols = Cnt_Cols - grdName.FixedCols Exit For Else VisibleCols = grdName.Cols End If Next Cnt_Cols End Function ■ 列の挿入、及び、削除 ' 列のインサート
Private Sub Command8_Click()
Call sInsertCol(3, 1000) ' 3 列目に幅 1000 の列を挿入 End Sub
Private Sub sInsertCol(InsCol As Long, ColWid As Long) Dim i As Long Dim j As Long With MSFlexGrid1 .Visible = False .ColWidth(InsCol) = ColWid .Cols = .Cols + 1 '１列増やす ' 此の様に必要に依り隣のセルの情報を引き継ぐ .ColWidth(.Cols - 1) = .ColWidth(.Cols - 2) For i = 0 To .Rows - 1 .Row = i
For j = .Cols - 1 To InsCol Step -1 ' 挿入列以降のデータを移動 ' データを移動
.TextMatrix(i, j) = .TextMatrix(i, j - 1) If j = InsCol Then
.TextMatrix(i, j) = "" ' 挿入列のデータを Null に設定 End If Next j Next i .Visible = True End With End Sub ' 列の削除
Private Sub Command9_Click()
Call sDeleteCol(3) ' ３列目を削除 End Sub
Private Sub sDeleteCol(DelCol As Long) Dim i As Long Dim j As Long With MSFlexGrid1 .Visible = False For i = 0 To .Rows - 1 .Row = i
For j = DelCol + 1 To .Cols - 1 ' 削除列以降のデータを移動 .TextMatrix(i, j - 1) = .TextMatrix(i, j) Next j Next i .Cols = .Cols - 1 .Visible = True End With End Sub ' 列の入れ替え
Private Sub Command12_Click()
Call sSwapCol(3, 5) ' ３列目と５列目を入替える End Sub
Private Sub sSwapCol(SwapCol1 As Long, SwapCol2 As Long) Dim i As Long
Dim ColData As Variant With MSFlexGrid1 .Visible = False
'.ColWidth(InsCol) = ColWid For i = 0 To .Rows - 1 ' データを退避
ColData = .TextMatrix(i, SwapCol1) ' データを移動
.TextMatrix(i, SwapCol1) = .TextMatrix(i, SwapCol2) '退 避して置いたデータを移し変え
.TextMatrix(i, SwapCol2) = ColData Next i .Visible = True End With End Sub セル内の書式等は考慮して居ない。亦、最終列の削除等のエラー処理はして居ない。各自の環境に合せて作り直 す必要が有る。
■ MSFlexGrid のカラー印刷 Private Sub Command10_Click() Dim frmLeft As Long
Dim frmTop As Long Dim frmWidth As Long Dim frmHeight As Long Dim frmbakcol As Long Dim mfgLeft As Long Dim mfgTop As Long Dim mfgWidth As Long Dim mfgHeight As Long ' 元の位置とサイズを取得 With Form1 frmbakcol = .BackColor frmLeft = .Left frmTop = .Top frmWidth = .Width frmHeight = .Height ' フォームをグリッドの大きさに合せる
.Move 0, 0, MSFlexGrid1.Width + 150, MSFlexGrid1.Height + 850 .BackColor = QBColor(15) End With With MSFlexGrid1 mfgLeft = .Left mfgTop = .Top mfgWidth = .Width mfgHeight = .Height ' 表示位置を左上に .Move 0, 0 End With DoEvents ' 画面､フォーム､ウインドウを取り込んで印刷する方法 With Picture1 .AutoSize = True .AutoRedraw = True
Set .Picture = CaptureClient(Me) Call sPrint
.AutoRedraw = False End With
DoEvents
' 元の位置とサイズに戻す
Form1.Move frmLeft, frmTop, frmWidth, frmHeight
MSFlexGrid1.Move mfgLeft, mfgTop, mfgWidth, mfgHeight Form1.BackColor = frmbakcol
DoEvents End Sub
Private Sub sPrint() On Error Resume Next Dim lngHeight As Long Dim lngWidth As Long Dim sngHZoomRitu As Single Dim sngWZoomRitu As Single Picture1.ScaleMode = vbTwips Printer.ScaleMode = vbTwips
' 用紙サイズをＡ４に設定 Printer.PaperSize = vbPRPSA4 ' 用紙方向を横向きに設定 Printer.Orientation = vbPRORLandscape ' Image ファイルの寸法を取得 lngHeight = Picture1.Height lngWidth = Picture1.Width ' 印刷サイズより画像サイズが大きい場合而巳縮小
If lngHeight > Printer.Height - 1100 Or lngWidth > Printer.Width - 1800 Then ' 拡大・縮小率を計算
sngHZoomRitu = (Printer.Height - 1100) / lngHeight sngWZoomRitu = (Printer.Width - 1800) / lngWidth ' 元のサイズの縦横比で用紙一杯に拡大・縮小 If sngHZoomRitu < sngWZoomRitu Then lngHeight = lngHeight * sngHZoomRitu lngWidth = lngWidth * sngHZoomRitu Else
lngHeight = lngHeight * sngWZoomRitu lngWidth = lngWidth * sngWZoomRitu End If
End If
Printer.PaintPicture Picture1.Image, 800, 400, lngWidth, lngHeight Printer.EndDoc ' 印刷開始
End Sub
■ MSFlexGrid のカラー印刷（Picture に表示して Picture を印刷）其の２
MSFlexGrid1.Picture を使用する事で MSFlexGrid のスナップショットが取れる。其れをクリップボードや Picture コントロールに設定する事で簡単に印刷する事が出来る（VB5.0、VB6.0 で可能で有る）。
Private Sub Command11_Click() With MSFlexGrid1 .TopRow = .FixedRows ' 用紙に入ら無い場合は、此処を変更して２枚目に印刷する .LeftCol = .FixedCols .PictureType = flexPictureColor ' 高品質のカラー End With With Picture1 .AutoSize = True .AutoRedraw = True ' Picture コントロールへ MSFlexGrid1 のスナップショットを送る .Picture = MSFlexGrid1.Picture
Printer.EndDoc .AutoRedraw = False End With End Sub 上記の孰れの方法も画面イメージを印刷して居る。従って、文字等は綺麗に印刷されないし、画像と仕ての印刷 設定しか出来ない。綺麗に印字し度い場合や細かい設定で印刷し度い場合は、データーを印字する（罫線・改ペ ージ処理含む）の様に地道にコードを記述する必要が有る。 ■ ワードラップ時に行の高さを自動調整 Option Explicit
Private Sub Form_Load()
With lblTemp ' ラベルを見え無い位置に配置 .AutoSize = True .WordWrap = True .Visible = False End With Form1.Move 0, 0, 7400, 4000 ' MSFlexGrid の初期設定 With MSFlexGrid1 .Move 200, 200, 6800, 2600 .Rows = 8 ' 行の総数（固定行含む） .Cols = 6 ' 列の総数（固定列含む） .WordWrap = True .AllowUserResizing = flexResizeBoth .FixedRows = 1 ' 固定行の数（Rows より１以上尐ない事） .FixedCols = 1 ' 固定列の数（Cols より１以上尐ない事） .TextMatrix(1, 1) = "あいうえ A" .TextMatrix(2, 2) = "あいうえお"
.TextMatrix(3, 3) = "あいうえお kakiku keko" .TextMatrix(4, 4) = "あいうえおさしすせそ" End With
End Sub
Private Sub Command1_Click()
' 総てのセルの高さを自動調整する場合 Call AutoCellHeight(0, 0)
End Sub
Private Sub Command2_Click() ' 標準の高さに設定
MSFlexGrid1.RowHeight(-1) = -1 End Sub
Private Sub MSFlexGrid1_DblClick() With MSFlexGrid1
Call AutoCellHeight(.Row, .Col) End With
End Sub
Private Sub AutoCellHeight(MyRow As Long, MyCol As Long) Dim RowStrt As Long ' スタートの列 Dim RowEnd As Long ' 終りの列
Dim i As Long, j As Long ' ループ用のカウンタ Dim TxtHeight As Long ' 文字の高さ
Dim NewHeight As Long ' 変更後のセルの高さ With MSFlexGrid1 .Visible = False ' 非表示に（ちらつき防止・処理が早い） RowStrt = MyRow ' 個別か全体化を判断 RowEnd = MyRow If MyRow = 0 Then ' 全体の設定の場合 RowStrt = 0 RowEnd = .Rows - 1 End If
For i = RowStrt To RowEnd NewHeight = 0
For j = 0& To .Cols - 1 ' 其の行内で一番高いセルを取得 .Row = i .Col = j ' セルとラベルのフォントを同じに設定 lblTemp.FontSize = .CellFontSize lblTemp.FontName = .CellFontName lblTemp.FontBold = .CellFontBold lblTemp.FontItalic = .CellFontItalic ' ラベルに文字列を設定して高さを取得 lblTemp.Caption = .TextMatrix(i, j) lblTemp.Width = .ColWidth(j) - 90 TxtHeight = lblTemp.Height ' 折返しを含めた高さを取得 If NewHeight < TxtHeight Then
NewHeight = TxtHeight ' 行内で一番高いセルの高さを取得 End If
Next j
.RowHeight(i) = NewHeight + 40 ' 余白分をプラスして設定 Next i
If MyCol = 0 And MyRow = 0 Then ' ホームポジションへ移動 .Col = .FixedCols .Row = .FixedRows Else .Row = MyRow ' 元のセル位置に移動 .Col = MyCol - 1 End If .Visible = True End With End Sub lblTemp と名付けたラ ベルコントロールを１ 個見え無い所にでも配 置して置く。セルの内 容をラベルに表示して、 其の時にラベルのサイ ズをセルに設定する事 で実現して居る。
ＡＰＩを使った同様のサンプル
別途同様にラベルとテキストボックスが必要で有る。 Option Explicit
' 指定のウインドウにメッセージを送る API
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long ' テキストの行数を取得する定数
Private Const EM_GETLINECOUNT = &HBA Private Sub Form_Load()
With txtTemp ' テキストボックスを見え無い位置に配置 '.MultiLine = True ' 別途プロパティで設定して置く .Visible = False End With With lblTemp ' ラベルを見え無い位置に配置 .AutoSize = True .Visible = False End With Form1.Move 0, 0, 7400, 4000 'MSFlexGrid の初期設定 With MSFlexGrid1 .Move 200, 200, 6800, 2600 .Rows = 8 ' 行の総数（固定行含む） .Cols = 6 ' 列の総数（固定列含む） .WordWrap = True .AllowUserResizing = flexResizeBoth .FixedRows = 1 ' 固定行の数（Rows より１以上尐ない事） .FixedCols = 1 ' 固定列の数（Cols より１以上尐ない事） .TextMatrix(1, 1) = "あいうえ A" .TextMatrix(2, 2) = "あいうえお"
.TextMatrix(3, 3) = "あいうえお kakiku keko" .TextMatrix(4, 4) = "あいうえおさしすせそ" End With
End Sub
Private Sub MSFlexGrid1_DblClick() With MSFlexGrid1
Call AutoCellHeight(.Row, .Col) End With
End Sub
Private Sub Command1_Click()
' 総てのセルの高さを自動調整する場合 ' 起動時データを読込んで表示する場合に Call AutoCellHeight(0, 0)
End Sub
Private Sub Command2_Click() ' 標準の高さに設定
MSFlexGrid1.RowHeight(-1) = -1 End Sub
Dim RowStrt As Long ' スタートの列 Dim RowEnd As Long ' 終りの列 Dim i As Long
Dim j As Long
Dim OldHeight As Long ' 文字の高さ Dim TxtHeight As Long ' 文字の高さ
Dim NewHeight As Long ' 変更後のセルの高さ Dim textLine As Long ' ワードラップ後の行数 With MSFlexGrid1 .Visible = False ' 非表示に（ちらつき防止・処理が早い） RowStrt = MyRow ' 個別か全体化を判断 RowEnd = MyRow If MyRow = 0 Then ' 全体の設定の場合 RowStrt = 0 RowEnd = .Rows - 1 End If
For i = RowStrt To RowEnd NewHeight = 0
For j = 0& To .Cols - 1 ' 其の行内で一番高いセルを取得 .Row = i .Col = j ' セルのフォントとテキストボックスのフォントを同じに設定 txtTemp.FontSize = .CellFontSize txtTemp.FontName = .CellFontName txtTemp.FontBold = .CellFontBold txtTemp.FontBold = .CellFontItalic ' セルの幅とテキストボックスの幅を同じに設定 txtTemp.Width = .ColWidth(j) lblTemp.FontSize = .CellFontSize txtTemp.Text = .TextMatrix(i, j) lblTemp.Caption = .TextMatrix(i, j) OldHeight = lblTemp.Height ' 文字の高さを取得
textLine = SendMessage(txtTemp.hwnd, EM_GETLINECOUNT, 0&, 0&) TxtHeight = textLine * OldHeight
If NewHeight < TxtHeight Then
NewHeight = TxtHeight ' 行内で一番高いセルの高さを取得 End If
Next j
.RowHeight(i) = NewHeight + 40 ' 余白分をプラスして設定 Next i
If MyCol = 0 And MyRow = 0 Then ' ホームポジションへ移動 .Col = .FixedCols .Row = .FixedRows Else .Row = MyRow ' 元のセル位置に移動 .Col = MyCol - 1 End If .Visible = True End With End Sub 此方は、セルの内容をテキストボックスに表示し、API を使用してテキストボックスの行数を求め、セルの高さ を設定して居る。孰れのサンプルも一つのセルの内容を変更すれば、其の行の総ての列のセルの内容を調べ、一 番行が高い値に設定して居る。然うで無いと、高く変更された場合は、問題無いが、低く変更された場合は、何 の列のセルが一番高いか調査し直さなければ、低く変更出来ないからで有る
■ MSFlexGrid のセル内を検索する Option Explicit
' 完全一致検索
Private Sub Command1_Click() Dim Ro As Long
Dim Co As Long Dim Ret As Long With MSFlexGrid1
For Ro = .FixedRows To .Rows - 1 For Co = .FixedCols To .Cols - 1
If Text1.Text = .TextMatrix(Ro, Co) Then .Col = Co
.Row = Ro .TopRow = Ro
Ret = MsgBox("此れですか", vbYesNo) If Ret = vbYes Then
Exit Sub End If End If Next Co Next Ro End With End Sub ' 前方一致検索
Private Sub Command2_Click() Dim Ro As Long
Dim Co As Long Dim Ret As Long With MSFlexGrid1
For Ro = .FixedRows To .Rows - 1 For Co = .FixedCols To .Cols - 1
If InStr(.TextMatrix(Ro, Co), Text1.Text) Then .Col = Co
.Row = Ro .TopRow = Ro
Ret = MsgBox("此れですか", vbYesNo) If Ret = vbYes Then
Exit Sub End If End If Next Co Next Ro End With End Sub
■ Excel ファイルを MSFlexGrid に表示（DAO を利用）
参照設定でMicrosoft DAO 3.6 Object Library にチェックを入れて置き、フォームに MSFlexGrid コントロール とデータコントロールを貼り付けて、デザイン時に下記プロパテイをセットして置く。
MSFlexGrid1.DataSource = Data1 Data1.Visible = False
Option Explicit
Private Sub Command1_Click() Dim DB As Database
Dim RS As Recordset Dim FileName As String MSFlexGrid1.Visible = False
' 読込用の Excel ファイル（パスを間違え無い様に） FileName = App.Path & "¥test.xls"
' ファイルをオープン（HDR=NO で項目を読み込まない様にする事も可能) Set DB = OpenDatabase(FileName, False, False, "Excel 8.0;HDR=YES;") ' テーブルの内容を格納（Sheet1 = Excel のシート名）
Set RS = DB.OpenRecordset("Sheet1$", dbOpenTable) ' MSFlexGrid と連結 Set Data1.Recordset = RS Data1.Refresh RS.Close DB.Close Set DB = Nothing Set RS = Nothing ' 参考：下記の部分の表示は 0.05 秒位 Dim i As Long With MSFlexGrid1 For i = 1 To .Rows - 1 .TextMatrix(i, 0) = i Next i End With MSFlexGrid1.Visible = True End Sub
WinXP AMD Duron 950MHz 256MBのマシンで5000行の８列のファイルの読込表示にMSFlexGridを非表示
で1.7 秒、表示状態で 3.1 秒と結構早く読み込める。因みに同じファイルを CSV 形式でシーケンシャルアクセス
モードでファイルを開くと、非表示状態でも8.0 秒懸かる。其の CSV ファイルを DAO を使用して読み込み表示
すると4 秒で表示する事が出来た。猶、コード中の "Excel 8.0;HDR=NO;" の Excel 8.0 は使用して居る Excel
のバージョンとは関係無い。特にExcel が導入されて居ない環境でも動作する筈で有る。
但し、読み込むデータに尐し制限が有る。デフォルトでは８行目迄のデータで多い方のデータ型で設定する。オ プション機能のIMEX=1; を追加して "Excel 8.0;HDR=YES;IMEX=1;" とすれば８行目迄のデータが同一カラ ム（列）内に混在して居る場合、テキスト型として扱う。従って、其の様な可能性が有るカラムには１行目に文 字列を入力して置くとか、項目名を必要なデータ型で作成するとか、項目を読み込まないとか、レジストリでデ フォルトの８行の設定を変更する等で対処する。
■ ADO を使用して CSV ファイルを読込
ADO を使用して CSV ファイルを MSHFlexGrid に表示するコード例を下記に示す。
先ず、参照設定でMicrosoft ActiveX Data Objects 2.5 Libraryにチェックを入れて置き、FormにMSHFlexGrid1
とCommand1 を貼り付けて置く。亦、カンマ区切りの Test.csv ファイルをプログラムと同じフォルダに準備し
て置く。
Option Explicit
Private Sub Command1_Click()
Dim CN As New ADODB.Connection Dim RS As New ADODB.Recordset
Dim FolderName As String, txtDRIVER As String Dim DataFile As String, strSQL As String Dim strProvider As String
Screen.MousePointer = vbHourglass MSHFlexGrid1.Clear DoEvents FolderName = App.Path ' データの有るフォルダを取得 DataFile = "Test.csv" ' データファイル名を取得 ' データベースに接続する為の情報を設定する
strProvider = "Provider=MSDASQL;Extended Properties=""" txtDRIVER = "DRIVER={Microsoft Text Driver (*.txt; *.csv)};DBQ=" CN.ConnectionString = strProvider & txtDRIVER & FolderName & """" ' コネクションをオープン
CN.Open
' Recordset オブジェクトのオープン strSQL = "Select * From " & DataFile
RS.Open strSQL, CN, adOpenStatic, adLockReadOnly, adCmdText Set MSHFlexGrid1.DataSource = RS ' MSHFlexGrid にデータを代入 ' Recordset・Connection を閉じる RS.Close CN.Close ' 参照を解放。 Set RS = Nothing Set CN = Nothing Screen.MousePointer = vbDefault End Sub ODBC 接続 Provider=MSDASQL 使用するデータベースの種類
Extended Properties="" ODBC ドライバーの為の設定は、Extended Properties = に 一括して与える｡此等を一纏めにする為に､" （ダブルコーテー ション）が利用される。上記のコードでは､文字列の中に入る " をエスケープする為に二重に記述して居る"
DRIVER={Microsoft Text Driver (*.txt; *.csv)} ODBC ドライバ名
DBQ=FolderName ODBC ドライバを使用して接続するデータベースファイル名
（フォルダ名）
User ID データベースに接続する時に使用するユーザ名 Password データベースに接続する時に使うパスワード FILE NAME データベースへの接続情報指定したデータリンクファイル名 DSN データベースへの接続情報指定したODBC データソース名 Location 接続先のサーバー名 Open メソッド
構文：Recordset.Open Source, ActiveConnection, CursorType, LockType, Options 例文：RS.Open strSQL, CN, adOpenStatic, adLockReadOnly, adCmdText Recordset： Recordset オブジェクトを表すオブジェクト変数 (RS) Source： 省略可能で有る。データを取得するテーブル名又はSQL ステートメント ActiveConnection： 省略可能で有る。接続中のデータベースを表すオブジェクト変数 （CN) CursorType： 省略可能で有る。カーソルタイプ（下記定数より選択） 定数 説明 adOpenForwardOnly デフォルトの値で有る。前方スクロールタイプカーソルを開く。 adOpenKeyset キーセットカーソルを開く。 adOpenDynamic 動的カーソルを開く｡ adOpenStatic 静的カーソルを開く｡ LockType： 省略可能で有る。ロックタイプ（下記定数より選択） 定数 説明 adLockReadOnly デフォルトの値で有る。読み取り専用（データの変更は出来ない）。 adLockPessimistic レコード毎の排他的ロック（通常、編集の際にプロバイダがデータソース でレコードをロックする事に依り、確実にレコードを編集出来る為に必要 な最小限のロックを使用する）。 adLockOptimistic レコード毎の共有的ロック（Update メソッドを呼び出した場合而巳、プ ロバイダが共有的ロックを使用してレコードをロックする）。 adLockBatchOptimistic 共有的バッチ更新（即時更新モードに対して、バッチ更新モードの場合に 必要で有る）。
Options： 省略可能で有る。Source 引数が Command オブジェクト以外の設定値を表す場合、又は、
以前に保存して居たファイルからRecordset を復元する場合に、プロバイダが引数を評価
する方法を示す IMEX=
0 is Export mode 1 is Import mode
■ 相対的位置関係で貼付
MSFlexGrid でコピーしたセルの相対的位置関係で貼付けるコード例を下記に示す。
Form に MSFlexGrid1 を 1 個と CommandButton を３個（cmdExit、cmdCopy、Mpaste）を貼り付けて置く。 Option Explicit
Private KeyCtrl As Boolean ' Ctrl キーが押されて居るかの判定 Private KeyClip As Boolean ' Shift キーが押されて居るかの判定 Private SelDatCount As Long ' セルデータのカウント
Private SelCopyCount As Long ' コピーした数のカウント Private PosiRow() As Integer ' コピーしたセルの Row Private PosiCol() As Integer ' コピーしたセルの Col Private SelDat() As Variant ' セルの内容取得用
Private strClip As String ' Clip プロパティ用の文字列格納用の変数 Private R1 As Integer ' 範囲選択用の Row 用
Private R2 As Integer ' 範囲選択用の RowSel 用 Private C1 As Integer ' 範囲選択用の Col 用 Private C2 As Integer ' 範囲選択用の ColSel 用
Private CopyMode As Boolean ' Copy ボタンクリック時のフラグ（True:Click） Private Sub SPasteClip()
On Error Resume Next
Dim nowRow As Integer ' 現時選択されて居る行 Dim nowCol As Integer ' 現在選択されて居る列 '連続した範囲をペーストする With MSFlexGrid1 nowRow = .Row nowCol = .Col If R1 = R2 Then .Row = nowRow .Col = nowCol .RowSel = nowRow .ColSel = C2 .Clip = strClip Else .Row = nowRow .Col = nowCol .RowSel = R1 + nowRow .ColSel = C2 .Clip = strClip End If End With KeyClip = False End Sub
Private Sub cmdExit_Click() Unload Me
End Sub
Private Sub cmdCopy_Click() CopyMode = True
SubDatCopy End Sub
Private Sub Form_Load() With MSFlexGrid1 .Rows = 14 .Cols = 7 .TextMatrix(1, 1) = "うし" .TextMatrix(1, 2) = "うま" .TextMatrix(1, 3) = "ぶた" .TextMatrix(2, 1) = "しまりす" .TextMatrix(2, 4) = "ひつじ" .TextMatrix(3, 3) = "くま" .RowHeight(-1) = 350 End With KeyCtrl = False KeyClip = False CopyMode = False End Sub ' 貼付け先のセルをクリックして、貼付ボタンをクリックする事で任意の場所に次々貼付け出来る｡ Private Sub Mpaste_Click()
Dim myRow As Integer Dim myCol As Integer Dim I As Integer CopyMode = False If KeyClip = True Then SPasteClip
KeyClip = False GoTo Owari
ElseIf KeyCtrl = True Then
' 今選択されて居るポジションを取得して置く With MSFlexGrid1 myRow = .Row myCol = .Col End With If SelDatCount = 0 Then KeyCtrl = False GoTo Owari End If
On Error GoTo Owari With MSFlexGrid1 For I = 1 To SelDatCount If I = 1 Then .Row = myRow .Col = myCol .Text = SelDat(I) Else
.Row = PosiRow(I) - PosiRow(1) + myRow .Col = PosiCol(I) - PosiCol(1) + myCol .CellBackColor = QBColor(15) .CellForeColor = QBColor(0) .Text = SelDat(I) End If Next I .Row = myRow .Col = myCol .CellBackColor = QBColor(15) .CellForeColor = QBColor(0) End With
KeyCtrl = False End If CopyMode = False Exit Sub Owari: For I = 1 To SelDatCount PosiRow(I) = 0 PosiCol(I) = 0 ReDim SelDat(0) KeyCtrl = False CopyMode = False Next I
Select Case Err.Number Case 30009, 30010 Dim msg As String msg = "コピーの範囲が、セルの外に出て仕舞います。" MsgBox msg End Select End Sub
Private Sub MSFlexGrid1_Click() If KeyCtrl = True Then
With MSFlexGrid1
If .CellBackColor = QBColor(1) Then ' 再クリックした場合セル色を元に .CellBackColor = QBColor(15) .CellForeColor = QBColor(0) Else ' セルに反転色を指定 .CellBackColor = QBColor(1) .CellForeColor = QBColor(15) End If End With End If End Sub
Private Sub SubDatCopy() Dim I As Integer
Dim J As Integer If KeyCtrl = True Then SelCopyCount = 0 SelDatCount = 0 ' 表示を早くする為に一旦非表示に設定 With MSFlexGrid1 .Visible = False ' 固定列は除く
For I = .FixedCols To .Cols - .FixedCols ' 固定行は除く
For J = .FixedRows To .Rows - .FixedRows .Row = J
.Col = I
' 反転色のセルを探す
If .CellBackColor = QBColor(1) Then SelDatCount = SelDatCount + 1
' データ、セルの位置を変数に格納して置く ReDim Preserve SelDat(SelDatCount) As Variant
ReDim Preserve PosiRow(SelDatCount) As Integer ReDim Preserve PosiCol(SelDatCount) As Integer ' 位置 PosiRow(SelDatCount) = J PosiCol(SelDatCount) = I ' 又はコピー先を指定して直接コピー SelDat(SelDatCount) = .Text .CellBackColor = QBColor(15) .CellForeColor = QBColor(1) End If Next J Next I .Visible = True End With ' 連続セル（ドラッグに依る） ElseIf KeyClip = True Then With MSFlexGrid1 R1 = .Row R2 = .RowSel C1 = .Col C2 = .ColSel strClip = .Clip End With End If End Sub
Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If KeyCtrl = True Then
Exit Sub End If
' False の時は Shift を判断する If Shift = vbCtrlMask Then
KeyCtrl = True 'Ctrl キーが押された KeyClip = False Else KeyCtrl = False End If End Sub
Private Sub MSFlexGrid1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) ' ドラッグした時は、Clip で処理
If CopyMode = True Then Exit Sub
End If
If KeyCtrl = False Then KeyClip = True Else KeyClip = False End If End Sub 操作１：連続して無いセル（コピーしたセルの相対的位置関係で貼付けられる） １．Ctrl キーを押し乍らクリックで選択（複数セル） ２．cmdCopy ボタンをクリック ３．貼り付けたい位置をクリック(（セル而巳で良い） ４．Mpaste ボタンをクリック
操作２：連続したセル（コピーしたセルの相対的位置関係で貼付けられる） １．コピーしたいセル範囲をドラッグで範囲選択 ２．cmdCopy ボタンをクリック ３．貼り付けたい位置をクリック（1 セル而巳で良い） ４．Mpaste ボタンをクリック ■ MSFlexGrid でセルの塗り潰しパターンを実現 MSFlexGrid でセルの背景色の塗り潰しのパターンを設定するコード例を下記に示す。 Form に MSFlexGrid1 と Command1、Command2 を貼り付けて置く。
Option Explicit
Private Sub Form_Load()
' 初期設定（別途プロパティで設定出来る物は設定して置く） With MSFlexGrid1 .Cols = 10 .Rows = 6 .RowHeight(-1) = 350 .Font.Bold = True .TextMatrix(2, 2) = "先に記入" End With With Picture1 .AutoRedraw = True .Appearance = 0 .BorderStyle = vbBSNone .Visible = False End With End Sub ' パターンに依る塗り潰しのテスト Private Sub Command1_Click() Dim i As Long, Pt As Long With MSFlexGrid1
For i = .FixedCols To .Cols - 1 ' １行総て表示 Call SetPattern(5, 2, i) If Pt < 8 Then ' 全パターン表示 Call SetPattern(Pt, 3, i) End If Pt = Pt + 1 Next i ' 表示してからセルにデータを表示した場合のテスト .TextMatrix(2, 4) = "後で記入" End With ' Row=4、Col=3 に VbCross（6-クロス）で表示 Call SetPattern(6, 4, 3) End Sub ' パターンを解除
Private Sub Command2_Click() Dim i As Long, Pt As Long With MSFlexGrid1
For i = .FixedCols To .Cols - 1 Call SetPattern(8, 2, i) If Pt < 8 Then Call SetPattern(8, 3, i) End If Pt = Pt + 1 Next i End With Call SetPattern(8, 4, 3) End Sub ' パターンの作成と塗り潰し処理 ' 用法：SetPattern(FiSty,Ro,Co) ' 引数：FiSty = Picture1.FillStyle（0 - 塗り潰し～7 - 網かけ迄、0～7 以外の場合は解除） ' Ro = Row、Co = Col
Private Sub SetPattern(ByVal FiSty As Integer, ByVal Ro As Long, ByVal Co As Long) With MSFlexGrid1 .Row = Ro .Col = Co Picture1.Cls ' ピクチャーのサイズをセルと同一に Picture1.Height = .CellHeight Picture1.Width = .CellWidth If FiSty >= 8 Or FiSty < 0 Then
' パターンの解除（Picture をクリア） Set .CellPicture = LoadPicture() Exit Sub
End If
' パターンの設定
Picture1.FillStyle = FiSty ' 枠の罫線が見え無い様に
Picture1.Line (-10, -10)-(.CellWidth, .CellHeight), QBColor(0), B ' セルにピクチャーを表示
Set .CellPicture = Picture1.Image End With
End Sub
MSFlexGrid では、バックカラーの設定でクロスや網掛けのハッチングが出来ない為、PictureBox を使用して実 現して居る。編集時や選択時で見辛ければ解除した方が良い。
■ 指定のセル範囲に罫線を設定
MSFlexGrid で指定のセル範囲に罫線を設定するコード例を下記に示す。
Form に MSFlexGrid1 と Command1、Picture1 を下図を参考に貼り付けて置く。 Option Explicit
' 初期設定（別途プロパティで設定出来る物は設定して置く） Private Sub Form_Load()
With MSFlexGrid1 .Cols = 10 .Rows = 10 .ColWidth(-1) = 1100 .RowHeight(-1) = 350 .Font.Bold = True .Col = 1: .Row = 2 .CellAlignment = flexAlignCenterCenter .TextMatrix(2, 1) = "先に記入" .Col = 3: .Row = 3 .CellAlignment = flexAlignCenterCenter .TextMatrix(3, 3) = "先に記入" .Col = 3: .Row = 5 .CellAlignment = flexAlignCenterCenter .TextMatrix(5, 3) = "先に記入" End With With Picture1 .AutoRedraw = True .Appearance = 0 .BorderStyle = vbBSNone .Visible = False End With End Sub
Private Sub Command1_Click() Call SetKeisen(0, 2, 1) ' 細枠 Call SetKeisen(1, 4, 1) ' 太枠 Call SetKeisen(2, 3, 3) ' ２重枠 Call SetKeisen(3, 5, 2) ' 複数列に太枠 Call SetKeisen(4, 5, 3) Call SetKeisen(5, 5, 4) Call SetKeisen(6, 2, 6) ' 複数行に太枠 Call SetKeisen(7, 3, 6) Call SetKeisen(7, 4, 6) Call SetKeisen(8, 5, 6) With MSFlexGrid1 .Col = 6: .Row = 3 .CellAlignment = flexAlignCenterCenter .TextMatrix(3, 6) = "後で記入" End With End Sub ' 色々な罫線の作成、及び、表示（後は此れを参考に作成する事）
Dim Wid As Long Dim Hei As Long With MSFlexGrid1 .Row = Ro .Col = Co Wid = .CellWidth Hei = .CellHeight Picture1.Cls ' ピクチャーのサイズをセルと同一に Picture1.Height = Hei Picture1.Width = Wid Select Case DrSty Case 0 ' 細枠
Picture1.Line (0, 0)-(Wid - 10, Hei - 10), QBColor(0), B Case 1 '太枠
Picture1.Line (0, 0)-(Wid - 10, Hei - 10), QBColor(0), B Picture1.Line (10, 10)-(Wid - 25, Hei - 25), QBColor(0), B Case 2 ' ２重枠
Picture1.Line (0, 0)-(Wid - 10, Hei - 10), QBColor(0), B Picture1.Line (30, 30)-(Wid - 45, Hei - 45), QBColor(0), B Case 3 ' 左側
Picture1.Line (0, 0)-(Wid, Hei - 10), QBColor(0), B Picture1.Line (10, 10)-(Wid + 10, Hei - 25), QBColor(0), B Case 4 ' 真中
Picture1.Line (-10, 0)-(Wid + 10, Hei - 10), QBColor(0), B Picture1.Line (-10, 10)-(Wid + 10, Hei - 25), QBColor(0), B Case 5 ' 右側
Picture1.Line (-10, 0)-(Wid - 10, Hei - 10), QBColor(0), B Picture1.Line (-10, 10)-(Wid - 25, Hei - 25), QBColor(0), B Case 6 ' 上側
Picture1.Line (0, 0)-(Wid - 10, Hei), QBColor(0), B Picture1.Line (10, 10)-(Wid - 25, Hei), QBColor(0), B Case 7 ' 中央
Picture1.Line (0, -10)-(Wid - 10, Hei), QBColor(0), B Picture1.Line (10, -10)-(Wid - 25, Hei), QBColor(0), B Case 8 ' 下側
Picture1.Line (0, -10)-(Wid - 10, Hei - 10), QBColor(0), B Picture1.Line (10, -10)-(Wid - 25, Hei - 25), QBColor(0), B End Select
' セルにピクチャーを表示
Set .CellPicture = Picture1.Image End With End Sub MSFlexGrid では個別のセル範囲に罫線を引けない為、Picture に罫線を描いて、其れを指定のセルに貼り付け る事で、セル罫線の表示を実現して居る。此れは、MSFlexGrid でセルの背景色の塗り潰しのパターンの設定を 応用した物で有る。 編集時や選択時に見辛ければ、一旦解除する様にすると良い。削除する場合は、指定のセル位置で、下記の様に 実行する。
Set MSFlexGrid1.CellPicture = LoadPicture()
亦、セル幅（セル高さ）をユーザが変更出来る様に設定して有る場合は、別途変更されたか何うかを監視して（結
