VBレスキュー(花ちゃん)
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ各掲示板

リンク元へ戻ります。 グリッド(MSFlexGrid)関係のメニュー
1.MSFlexGrid の主要プロパティ・メソッド一覧表
2.MSFlexGrid ワンポイントテクニック集(その1)
3.MSFlexGrid ワンポイントテクニック集(その2)
4.MSFlexGrid で Excel のようにセルに直接データを入力する
5.MSFlexGrid/MSHFlexGridへのデータ表示設定色々
6.MSFlexGrid/MSHFlexGrid の表示データをファイルに保存方法色々
7.MSFlexGrid/MSHFlexGrid で項目(科目)別集計をする
8.MSFlexGrid/MSHFlexGrid でコピー・アンド・ペースト色々
9.MSFlexGrid/MSHFlexGrid で列幅設定/行の高さ設定色々
10.MSFlexGrid/MSHFlexGrid にチェックボックスを表示する及び操作色々
11.MSFlexGrid/MSHFlexGrid に表示中のデータを罫線付きで印刷する
12.
13.
14.
15.
16.
17.
18.
19.
20.その他、MSFlexGrid 関係で当サイト内に掲載しているサンプルの紹介


8.MSFlexGrid/MSHFlexGrid でコピー・アンド・ペースト色々
1.Ctr + C 及び Ctr + V によるコピー・アンド・ペーストを実装する
2.クリップボードを経由しない MSHFlexGrid 間での Ctr + C 及び Ctr + V によるコピー・アンド・ペースト
3.選択範囲を指定しての MSHFlexGrid 間での Ctr + C 及び Ctr + V によるコピー・アンド・ペースト
4.クリップボードを利用しての Excel / MSHFlexGrid 間での相互利用
5.MSFlexGridでコピーしたセルの相対的位置関係で貼付
6. 


 下記プログラムコードに関する補足・注意事項 
動作確認:Windows Vista・Windows 7 (32bit) / VB6.0(SP6)
Option :[Option Explicit]
参照設定:
使用 API:
その他 :プロジェクト→コンポーネント→コントロールで Microsoft FlexGrid Control 6.0(SP6) 又は、
    :Microsoft Hierarchical FlexGridにチェックを入れ、表示されたコントロールをフォームに貼り付けて下さい。
    :尚、当サイトで掲載している MSFlexGrid / MSFlexGrid 関係のサンプルは、上記と同様とし、今後は省略します。
このページのトップへ移動します。 1.Ctr + C 及び Ctr + V によるコピー・アンド・ペーストを実装する
1.MSHFlexGrid のカレントセルのデータをクリップボードにコピーする
2.クリップボード内のテキストデータを 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 イベント内で使用するかメニュー等のクリックイベントに実装する等してお使い下さい。

このページのトップへ移動します。 2.クリップボードを経由しない 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

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

このページのトップへ移動します。 3.選択範囲を指定しての 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 によるコピー・アンド・ペーストです。
エラー処理はしておりませんので、仕様に合わせて実装して下さい。

このページのトップへ移動します。 4.クリップボードを利用しての Excel / MSHFlexGrid 間での相互利用

1.MSHFlexGrid で選択範囲をクリップボードにコピー
  このデータを Excel 上で貼り付けを実施するとそのまま使用できます。
2.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 のコピーしたデータを貼り付けても問題ないようにはしておりますが、他の表形式のデータは動作確認しておりませんので、実装時には区切り文字等に注意してご使用下さい。
尚、貼り付け範囲等のエラーチェックは省略しております。

このページのトップへ移動します。 5.MSFlexGridでコピーしたセルの相対的位置関係で貼付

以前 neptuneさんより他の皆さんのお役に立てるかと思い、送らせて頂ましたと言って送って頂いた分です。以前は圧縮ファイルで紹介していたのですが、今回ここで紹介させて頂きます。
Form に MSFlexGrid1 1個と CommandButton 3個(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



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

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

このページのトップへ移動します。 6.


このページのトップへ移動します。 検索キーワード及びサンプルコードの別名(機能名)
MSFlexGrid で項目別集計をする MSHFlexGrid で項目別集計をする 科目別集計 売上集計
MSFlexGrid で支店別部署別集計をする MSHFlexGrid で支店別部署別集計をする 部門別集計
フレキシブルグリッド (MSFlexGrid) コントロール 階層フレキシブルグリッド (MSHFlexGrid) コントロール 

このページのトップへ移動します。