| |
「こんな感じ？」というものを作ってみました。
でも「コメント→フォーム」と間違えて「フォーム→コメント」を押すと
いきなり反映（場合によっては、いきなりコメント削除）されてしまい
使い勝手が良くないかもしれませんね。
Private Sub CommandButton1_Click()
'フォーム→コメント
Dim 対象セル As Range
Dim コメントの中身 As String
Dim テキストボックスの中身 As String
Dim i As Long
'------------------------------
'指定された日付を持つセルを探す
'------------------------------
On Error Resume Next
'1.日付が入っているであろう範囲(A3〜G8)を対象に検索機能を
' 使って指定された日付を持つセルを探す。(xlWhole=完全一致)
' 見つからなかった場合にエラーでマクロが止まってしまわないように
' 探す前に「On Error Resume Next」を指定しておき、
' 探し終わったら「On Error GoTo 0」で元の状態(エラーならマクロが
' 止まる)に戻す。
Set 対象セル = Range("A3:G8").Find(What:=ComboBox1.Value, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False, _
SearchFormat:=False)
On Error GoTo 0
'2.上で見つかったかチェック
If 対象セル Is Nothing Then
'3.ここへ来るって事は無かったって事なのでメッセージを出して
' Exit Subで処理を抜ける。
MsgBox "入力した日はありません"
Exit Sub
End If
'--------------------------------
'テキストボックス→コメントへ設定
'--------------------------------
'4.６個あるテキストボックスの内容を改行(vbLf)で繋ぐ
' (変数：コメントの中身に繋いだものをいれていく)
For i = 1 To 6
Select Case i
Case 1
テキストボックスの中身 = TextBox1.Value
Case 2
テキストボックスの中身 = TextBox2.Value
Case 3
テキストボックスの中身 = TextBox3.Value
Case 4
テキストボックスの中身 = TextBox4.Value
Case 5
テキストボックスの中身 = TextBox5.Value
Case 6
テキストボックスの中身 = TextBox6.Value
End Select
If テキストボックスの中身 <> "" Then
'5.テキストボックスに何か入っているなら繋ぐ。
If コメントの中身 <> "" Then
'6.既に何か設定されていれば改行(vbLf)を挟む。
' (これによりイキナリ改行が入ったり、最後に意味も無く
' 改行が入るのを防ぐ)
コメントの中身 = コメントの中身 & vbLf
End If
'7.繋いで設定
コメントの中身 = コメントの中身 & テキストボックスの中身
End If
Next
'8.各行ごとに「対象セル.なんとか」と書くのがメンドーなので
' With〜End Withを使う
With 対象セル
'9.既にコメントがあろうがなかろうがいったんコメントを消す。
' (もともとコメントが無くてもエラーにはならない)
.ClearComments
'10.4〜7でテキストボックスの内容を繋いだ結果、なんか入っているなら
' それをコメントに設定する。
If コメントの中身 <> "" Then
.AddComment 'コメント挿入
.Comment.Visible = False 'コメントを隠す（出しっぱなしにしない）
.Comment.Text Text:=コメントの中身 '中身を設定
.Comment.Shape.TextFrame.AutoSize = True '自動サイズ調整ＯＮ
End If
End With
End Sub
Private Sub CommandButton2_Click()
'コメント→フォーム
Dim 対象セル As Range
Dim コメントの中身 As Variant
Dim i As Long
'------------------------------
'指定された日付を持つセルを探す
'------------------------------
On Error Resume Next
'1.Button1と全く同じなので説明は割愛
Set 対象セル = Range("A3:G8").Find(What:=ComboBox1.Value, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False, _
SearchFormat:=False)
On Error GoTo 0
If 対象セル Is Nothing Then
MsgBox "入力した日はありません"
Exit Sub
End If
'--------------------------------------
'コメントの中身をテキストボックスに設定
'--------------------------------------
If 対象セル.Comment Is Nothing Then
'2.セルはコメントを持っていないので
' テキストボックスに設定することが出来ない。
' だからテキストボックスをクリアする。
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
Else
'3.コメントの内容(対象セル.Comment.Text)をSplit関数で
' 改行(vbLf)毎に分解して変数「コメントの中身」に格納する。
' (詳しくはSplit関数のヘルプ参照)
コメントの中身 = Split(対象セル.Comment.Text, vbLf)
'4.LBound関数,UBound関数でいくつに分解されたか調べて
' そのぶんをテキストボックスに設定する。
For i = LBound(コメントの中身) To UBound(コメントの中身)
Select Case i
Case 0
TextBox1.Value = コメントの中身(i)
Case 1
TextBox2.Value = コメントの中身(i)
Case 2
TextBox3.Value = コメントの中身(i)
Case 3
TextBox4.Value = コメントの中身(i)
Case 4
TextBox5.Value = コメントの中身(i)
Case 5
TextBox6.Value = コメントの中身(i)
End Select
Next
'5.上で設定されなかったテキストボックスはクリアしておく。
For i = i To 5
Select Case i
Case 0
TextBox1.Value = ""
Case 1
TextBox2.Value = ""
Case 2
TextBox3.Value = ""
Case 3
TextBox4.Value = ""
Case 4
TextBox5.Value = ""
Case 5
TextBox6.Value = ""
End Select
Next
End If
End Sub
コメントをいっぱい書いたのでいろいろ研究してみてくださいませ。
|
|
へっぽこ
- 07/1/18(木) 15:34 -
