MSFlexGrid/MSHFlexGrid でコピー・アンド・ペースト色々(VB6.0)

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

１．Ctr + C 及び Ctr + V によるコピー・アンド・ペーストを実装する

１．MSHFlexGrid のカレントセルのデータをクリップボードにコピーする
２．クリップボード内のテキストデータを MSHFlexGrid の指定のセルに貼り付け

Private Sub MSHFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
　　'Ctr + C によるカレントセルのコピー
　　If KeyCode = vbKeyC And Shift = vbCtrlMask Then
　　　　Clipboard.SetText MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, MSHFlexGrid1.col)
　　End If

　　'Ctr + V によるカレントセルへの貼り付け
　　If KeyCode = vbKeyV And Shift = vbCtrlMask Then
　　　　'クリップボードにテキストデータが入っているかチェック
　　　　If Clipboard.GetFormat(vbCFText) Then
　　　　　　'テキストデータならテキストボックスに貼り付け
　　　　　　MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, MSHFlexGrid1.col) = Clipboard.GetText()
　　　　End If
　　End If
End Sub

単一セルに対してのクリップボード経由のコピー＆貼り付けです。
このまま KeyDown イベント内で使用するかメニュー等のクリックイベントに実装する等してお使い下さい。

２．クリップボードを経由しない MSHFlexGrid 間での Ctr + C 及び Ctr + V によるコピー・アンド・ペースト

Private CopyDat As Variant

Private Sub MSHFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
　　'Ctr + C によるカレントセルのコピー
　　If KeyCode = vbKeyC And Shift = vbCtrlMask Then
　　　　CopyDat = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, MSHFlexGrid1.col)
　　End If

　　'Ctr + V によるカレントセルへの貼り付け
　　If KeyCode = vbKeyV And Shift = vbCtrlMask Then
　　　　MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, MSHFlexGrid1.col) = CopyDat
　　End If
End Sub

単一セルに対してのコピー＆貼り付けです。

３．選択範囲を指定しての MSHFlexGrid 間での Ctr + C 及び Ctr + V によるコピー・アンド・ペースト

Private ClipDat As Variant

Private Sub MSHFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
　　'Ctr + C による選択範囲のセルのコピー
　　If KeyCode = vbKeyC And Shift = vbCtrlMask Then
　　　　ClipDat = MSHFlexGrid1.Clip '選択範囲のセルデータを取得
　　End If

　　With MSHFlexGrid1
　　　　'Ctr + V によるカレントセルから選択範囲を貼り付け
　　　　If KeyCode = vbKeyV And Shift = vbCtrlMask Then
　　　　　　Dim cs As Long, ce As Long, rs As Long, re As Long
　　　　　　cs = .col
　　　　　　rs = .Row
　　　　　　.col = cs
　　　　　　.Row = rs
　　　　　　re = UBound(Split(ClipDat, vbCr))
　　　　　　ce = UBound(Split(ClipDat, vbTab)) / (re + 1)
　　　　　　.RowSel = rs + re
　　　　　　.ColSel = ce + cs
　　　　　　.Clip = ClipDat
　　　　End If
　　End With
End Sub

選択範囲を指定しての MSHFlexGrid 間での Ctr + C 及び Ctr + V によるコピー・アンド・ペーストです。
エラー処理はしておりませんので、仕様に合わせて実装して下さい。

４．クリップボードを利用しての Excel / MSHFlexGrid 間での相互利用

１．MSHFlexGrid で選択範囲をクリップボードにコピー
　　このデータを Excel 上で貼り付けを実施するとそのまま使用できます。
２．Excel 上で選択範囲をコピーしたデータをクリップボード経由で取得して MSHFlexGrid 上に貼り付け

Private Sub MSHFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)

　　'Ctr + C によるカレントセル(範囲)のコピー
　　If KeyCode = vbKeyC And Shift = vbCtrlMask Then
　　　　Clipboard.Clear
　　　　Clipboard.SetText MSHFlexGrid1.Clip
　　End If

　　With MSHFlexGrid1
　　　　'Ctr + V によるカレントセルから選択範囲を貼り付け
　　　　If KeyCode = vbKeyV And Shift = vbCtrlMask Then
　　　　　　Dim cs As Long, ce As Long, rs As Long, re As Long
　　　　　　Dim myDate As Variant
　　　　　　If Clipboard.GetFormat(vbCFText) Then
　　　　　　　　myDate = Clipboard.GetText
　　　　　　End If
　　　　　　cs = .col
　　　　　　rs = .Row
　　　　　　.col = cs
　　　　　　.Row = rs
　　　　　　If InStr(myDate, vbCrLf) > 0 Then
　　　　　　　　'Excel のデータの場合
　　　　　　　　re = UBound(Split(myDate, vbCrLf)) - 1
　　　　　　Else
　　　　　　　　'MSHFlexGrid のデータの場合
　　　　　　　　re = UBound(Split(myDate, vbCr))
　　　　　　End If
　　　　　　ce = UBound(Split(myDate, vbTab)) / (re + 1)
　　　　　　.RowSel = rs + re
　　　　　　.ColSel = ce + cs
　　　　　　.Clip = myDate
　　　　End If
　　End With
End Sub

一応、MSHFlexGrid のコピーしたデータを貼り付けても問題ないようにはしておりますが、他の表形式のデータは動作確認しておりませんので、実装時には区切り文字等に注意してご使用下さい。
尚、貼り付け範囲等のエラーチェックは省略しております。

５．MSFlexGridでコピーしたセルの相対的位置関係で貼付

以前 neptuneさんより他の皆さんのお役に立てるかと思い、送らせて頂ましたと言って送って頂いた分です。以前は圧縮ファイルで紹介していたのですが、今回ここで紹介させて頂きます。
Form に MSFlexGrid1 1個と CommandButton ３個(cmdExit cmdCopy Mpaste) を貼り付けておいて下さい

Option Explicit

Dim KeyCtrl As Boolean　　　'Ctrl キーが押されているかの判定
Dim KeyClip As Boolean　　　'Shiftキーが押されているかの判定
Dim SelDatCount As Long　　 'セルデータのカウント
Dim SelCopyCount As Long　　'コピーした数のカウント
Dim PosiRow() As Integer　　'コピーしたセルのRow
Dim PosiCol() As Integer　　'コピーしたセルのCol
Dim SelDat() As Variant　　 'セルの内容取得用
Dim strClip As String　　　 'Clipプロパティ用の文字列格納用の変数
Dim R1 As Integer　　　　　 '範囲選択用のRow用
Dim R2 As Integer　　　　　 '範囲選択用のRowSel用
Dim C1 As Integer　　　　　 '範囲選択用のCol用
Dim C2 As Integer　　　　　 '範囲選択用のColSel用
Dim 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 = R2 + nowRow - R1
　　　　　　.ColSel = C2 + nowCol - C1
　　　　　　.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

'　　Debug.Print "grid_click　"; "Ctrl: " & KeyCtrl; "　　Clip: " & KeyClip

　　　　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

'　　Debug.Print "grid_click　"; "Ctrl: " & KeyCtrl; "　　Clip: " & KeyClip

End Sub

'データを入力してのテストをしていませんので、バグ等ありましたらお許し下さい。
'Ctrl キーを押しながらクリックしたセルを反転色にして、
'後で(コピー等する前)反転色のセルを調べそのセルの
'内容を変数に代入(コピー先に貼り付け)しています。

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
　　　　　　　　 Debug.Print J, 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
'　　Debug.Print "MouseDown　 "; "Ctrl: " & KeyCtrl; "　　Clip: " & KeyClip
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

'　　Debug.Print "MouseUp　 "; "Ctrl: " & KeyCtrl; "　　Clip: " & KeyClip
End Sub

操作　１　連続してないセル
１．Ctrlキーを押しながらクリックで選択(複数セル）
２．cmdCopyボタンをクリック
３．貼り付けたい位置をクリック(1セルのみで良い)
４．Mpasteボタンをクリック
５．コピーしたセルの相対的位置関係で貼付けられます

操作　２　連続したセル
１．コピーしたいセル範囲をドラッグで範囲選択
２．cmdCopyボタンをクリック
３．貼り付けたい位置をクリック(1セルのみで良い)
４．Mpasteボタンをクリック
５．コピーしたセルの相対的位置関係で貼付けられます

６．

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

MSFlexGrid で項目別集計をする　MSHFlexGrid で項目別集計をする　科目別集計　売上集計
MSFlexGrid で支店別部署別集計をする　MSHFlexGrid で支店別部署別集計をする　部門別集計
フレキシブルグリッド (MSFlexGrid) コントロール　階層フレキシブルグリッド (MSHFlexGrid) コントロール　

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

Visual Basic 6.0