VBAテンプレート Excelの表を1つずつクリップボード保存
自分用の投稿です。
Excelの表の文字列を１セルずつクリップボードにコピーしていきます。
フォームのNextボタンを押すと、次に進みます。
コピー済みのものはグレーアウトしていくので、どこまで進んでいるかがわかります。
Web入力の場面で、自動化するほど量がなく、手動で入力するしかない時に、使います。
ツールの利用方法
■ツールの使い方
①Excelファイル（TableCopyTool.xlsm）に対象のシートを追加してください。
②10～14行目のB列に値を設定してください。
B10セル「参照シート」はCopy対象となるシートです。
B11～B14はコピーする範囲を指定しています。
※11，12行目の列数も数字を入力してください。例）A列→1、B列→2
③Tool開始ボタンを押してください。
④ポップアップが表示されます。Nextボタンや矢印ボタンを押して移動してください。
■Nextボタン説明
Nextを押すと列が右に進み、終了列までになると次の行へ進みます。
最終列の最終行に進んだときポップアップが表示されます。
■矢印ボタン説明
矢印を押すと１セルずつ移動します。
コピー中のセルは黄色くなります。
グレーアウトはせず、前のセルは塗りつぶしなしになります。
■終了ボタン
マクロを終了します。
右上の×ボタンも同じ仕様です。
#ツール作成方法
シートの作成
TableCopyTool.xlsmに「設定値シート」シートとコピー対象のシートを追加します。
★「設定値シート」シート
10～14行目のA列にタイトル、B列に値を入力します。
10行目：参照シート
11行目：開始列※数字で入力
12行目：終了列※数字で入力
13行目：開始行
14行目：終了行
任意の場所にTool開始ボタンを追加します。
ボタンにはマクロ「TableCopyTool」を設定します。
ソースコードの作成
今回フォーム、標準モジュール、クラスモジュールを1つずつ作成していきます。
ソースコード フォーム
標準モジュールに以下のソースコードを追加します。
オブジェクト名は「UserForm1」にしてください。
GUIで以下9個のオブジェクトを追加します。
フォームのサイズを幅（Width） = 300、高さ（Height） = 220にして、
それぞれのオブジェクトを追加、サイズを調整してください。
①NextButton
オブジェクト名：NextButton
種類：コマンドボタン
Caption：Next
説明：コピー対象のセルを次に進めるボタン
②UpButton
オブジェクト名：UpButton
種類：コマンドボタン
Caption：上↑
説明：コピー対象のセルを上に進めるボタン
③LeftButton
オブジェクト名：LeftButton
種類：コマンドボタン
Caption：左←
説明：コピー対象のセルを左に進めるボタン
④RightButton
オブジェクト名：RightButton
種類：コマンドボタン
Caption：右→
説明：コピー対象のセルを右に進めるボタン
⑤DownButton
オブジェクト名：DownButton
種類：コマンドボタン
Caption：下↓
説明：コピー対象のセルを下に進めるボタン
⑥EndButton
オブジェクト名：EndButton
種類：コマンドボタン
Caption：終了↓
説明：コピー処理を終了する
⑦currentPosition
オブジェクト名：currentPosition
種類：Label
Caption：現在地 行：- 列：-
説明：対象のセルの行と列数を表示する
⑧Label1
オブジェクト名：Label1
種類：Label
Caption：クリップボードに保存した文字列：
説明：クリップボードに保存した文字列のタイトル
⑨CopyTextView
オブジェクト名：CopyTextView
種類：Label
Caption：コピーなし
説明：クリップボードに保存した文字列を表示する。
ソースコードには以下を設定します。
Option Explicit
'settingClass 変数宣言
Private settingInstance As settingClass
'フォーム画面起動時に実行される処理
Private Sub UserForm_Initialize()
'フォームのサイズ設定
Me.Width = 300 ' 幅を300に設定
Me.Height = 220 ' 高さを220に設定
' 利用する情報をsettingClassクラスに設定
' クラスモジュール settingClass (コード) の Class_Initializeサブへ遷移
Set settingInstance = New settingClass
End Sub
'Nextボタン押下時の処理
Private Sub NextButton_Click()
'1つ前のセルをグレーアウトする
settingInstance.copyCell.Interior.ColorIndex = 15
'列数の確認
If settingInstance.columnNum < settingInstance.終了列Int Then
'最終列ではない場合、
'行：変更なし、列：右に１つ移動
'settingClassのcopyFnction処理呼び出し
Call settingInstance.copyFnction(0, 1)
Else
'最終列の場合、
'行：下に１つ移動、列：開始列へ移動
'settingClassのcopyFnction処理呼び出し
Call settingInstance.copyFnction(1, (settingInstance.開始列Int - settingInstance.columnNum))
End If
'最終行の確認
If settingInstance.rowNum = settingInstance.終了行Int _
And settingInstance.columnNum = settingInstance.終了列Int Then
'最終行かつ最終列の場合、メッセージを表示する
MsgBox "すべての行のコピーが終了しました。"
End If
End Sub
'終了ボタン
Private Sub EndButton_Click()
'オブジェクトを初期化（破棄）
Set settingInstance = Nothing
'マクロを終了する。
End
End Sub
'上矢印ボタン押下
Private Sub UpButton_Click()
'1つ前のセルを塗りつぶしなしにする
settingInstance.copyCell.Interior.ColorIndex = 0
'処理呼び出し
'行：上に１つ移動、列：変更なし
Call settingInstance.copyFnction(-1, 0)
End Sub
'下矢印ボタン押下
Private Sub DownButton_Click()
'1つ前のセルを塗りつぶしなしにする
settingInstance.copyCell.Interior.ColorIndex = 0
'処理呼び出し
'行：下に１つ移動、列：変更なし
Call settingInstance.copyFnction(1, 0)
End Sub
'右矢印ボタン押下
Private Sub RightButton_Click()
'1つ前のセルを塗りつぶしなしにする
settingInstance.copyCell.Interior.ColorIndex = 0
'処理呼び出し
'行：変更なし、列：右に１つ移動
Call settingInstance.copyFnction(0, 1)
End Sub
'左矢印ボタン押下
Private Sub LeftButton_Click()
'1つ前のセルを塗りつぶしなしにする
settingInstance.copyCell.Interior.ColorIndex = 0
'処理呼び出し
'行：変更なし、列：左に１つ移動
Call settingInstance.copyFnction(0, -1)
End Sub
ソースコード 標準モジュール
標準モジュールに以下のソースコードを追加します。
オブジェクト名は任意です。
'起動用
Sub TableCopyTool()
'ユーザフォーム画面を表示する
UserForm1.Show
End Sub
ソースコード クラス モジュール
クラス モジュールに以下のソースコードを追加します。
オブジェクト名は「settingClass」にしてください。
''共通変数の設定
'クリップボード保存のための設定
Private dataObj As New MSForms.DataObject
'コピーする文字列
Private textToCopy As String
'コピー対象のセルを宣言＆設定
Public copyCell As Range
Private targetSheet As Worksheet
'行・列の番号の設定
Public columnNum As Integer
Public rowNum As Integer
'開始終了行・列の設定
Public 開始列Int As Integer
Public 終了列Int As Integer
Public 開始行Int As Integer
Public 終了行Int As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 初期情報設定 クラスモジュール
' SettingClass
'
' 処理内容:ファイルの情報を設定する。
' 呼出元:Module1
' Classが宣言されたときに処理実行
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize()
'行数初期化
columnNum = 0
rowNum = 0
Dim confSheet As Worksheet
'設定値シートを設定
Set confSheet = ThisWorkbook.Sheets("設定値シート")
'設定値シートから値を設定
開始列Int = confSheet.Range("B11").Value
終了列Int = confSheet.Range("B12").Value
開始行Int = confSheet.Range("B13").Value
終了行Int = confSheet.Range("B14").Value
'コピー元のシートを設定
Set targetSheet = ThisWorkbook.Sheets(confSheet.Range("B10").Value)
'前面に表示
targetSheet.Activate
'先頭のセルをクリップボードに設定する
Call copyFnction(開始行Int, 開始列Int)
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' コピー処理 関数
' copyFnction
'
' 処理内容:行・列番号を再設定し、クリップボードに保存
' 該当のセルを黄色にする
' 引数
' 第一引数(rowPlusNum)：行数に追加する番号
' 第二引数(columPlusNum)：列数に追加する番号
' 呼出元:UserForm1
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function copyFnction(rowPlusNum As Integer, columPlusNum As Integer)
'引数に設定した値を行・列番号に加算する
rowNum = rowNum + rowPlusNum
columnNum = columnNum + columPlusNum
'行・列番号の補正
If rowNum <= 0 Then rowNum = 1
If columnNum <= 0 Then columnNum = 1
'コピー文字列の設定
Set copyCell = targetSheet.Cells(rowNum, columnNum)
textToCopy = copyCell.Value
'クリップボードに保存
dataObj.SetText textToCopy
dataObj.PutInClipboard
'Formに表示する
UserForm1.CopyTextView.Caption = copyCell.Value
UserForm1.currentPosition.Caption = "現在地 行：" & rowNum & " 列：" & columnNum
'コピーしたセルを黄色にする
copyCell.Interior.ColorIndex = 6
'ファイルを保存する。
ThisWorkbook.Save
End Function