複数の任意のデータを任意の場所に貼付け
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
複数の任意の場所のデータを任意の位置に貼付ける　　（０４０）
概略
Ctrlキーを押しクリックした位置のセルを反転色にします。
反転色のセルのデータを変数に代入します。
貼付け位置を指定し、貼付けボタンをクリックすることで１個づつ任意の位置に貼付けます。
ただし、この方法は全部のセルを参照するためデータ数が多いと効率が悪くなります。クリックした位置だけ調べる方法も考えたのですが、クリックした順番にしか貼付けができず今回の方法にしました。
セル数が５０００位までならこれでもいいかも？
宣言セクションに記入

Option Explicit　　 'SampleNo=040　WindowsXP VB6.0(SP5) 2002.05.03

Dim KeyCtrl　　　As Boolean　 'Ctrl キーが押されているかの判定
Dim SelDatCount　As Long　　　'セルデータのカウント
Dim SelDat()　　 As Variant　 'セルの内容取得用
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


Private Sub MSFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
'Ctrl キーの押下げを取得
　　If Shift = vbCtrlMask Then
　　　　KeyCtrl = True　　 'Ctrl キーが押された
　　　　SelDatCount = 0
　　　　SelCopyCount = 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
　　　　'全部貼り付けた場合
　　　　SelCopyCount = 0
　　　　SelDatCount = 0
　　　　ReDim SelDat(0)
　　　　Exit Sub
　　End If
　　With MSFlexGrid1
　　　　'クリック位置に貼付け
　　　　.Row = MyRow
　　　　.Col = MyCol
　　　　.Text = SelDat(SelCopyCount)
　　End With
End Sub




2002/05/03