Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


6319 / 13646 ツリー ←次へ | 前へ→

【45947】暦を作り、コメントをいれるには にしもり 07/1/18(木) 14:41 質問[未読]
【45948】Re:暦を作り、コメントをいれるには へっぽこ 07/1/18(木) 15:34 発言[未読]
【45950】Re:暦を作り、コメントをいれるには にしもり 07/1/18(木) 16:24 お礼[未読]

【45947】暦を作り、コメントをいれるには
質問  にしもり  - 07/1/18(木) 14:41 -

引用なし
パスワード
   こんにちは。
暦をつくり、日別になっているセルに、コメントをユーザフォームを経由して入れたいとおもっています。

A列はSUN,BはMON・・・G列はSATです。(1、2行目はタイトルです。)
したがって2007年1月なら"B3"に"1","C3"に"2"・・・"D7"に"31"と入っています。

いま、ユーザフォームのCOMBOBOXに1−31まで肢を設けます。
またTextBoxを計6個設けます。
COMBOBOXで1を選び、TextBoxにそれぞれ任意のcharを入れeNTERすると、"B3"にコメントとして入る、というふうにしたいのです。
(そのとき各TextBoxに入力された値は、改行して6行にして表示したい。)

下をご覧ください。
ここまで自力でできました。
ていうかこの方向性でいいのかわかりません。
どなたかこのあとどうすればいいかご教授ねがえませんでしょうか。

*****

Private Sub CommandButton1_Click()

Dim ComS As String
Dim Rc As Integer
Dim Sc As Long
Dim MyR As String
Dim C As Range
Dim flg As Boolean


For Each C In Range("A3", "B3", "C3", "D3", "E3", "F3", "G3", "A4", "B4", "C4", "D4", "E4", "F4", "G4", _
"A5", "B5", "C5", "D5", "E5", "F5", "G5", "A6", "B6", "C6", "D6", "E6", "F6", "G6", "A7", "B7", "C7", "D7", "E7", "F7", "G7")
  If C.Text = ComboBox1.Value Then Sc = C.Column
  If C.Text = ComboBox1.Value Then Rc = C.Row: Exit For
Next

If Sc = 0 Or Rc = 0 Then
  flg = True: GoTo Eline
End If

Eline:
Application.EnableEvents = False
If flg Then
  MsgBox "入力した日はありません"
Else

ComS = TextBox1.Value & TextBox2.Value & TextBox3.Value & TextBox4.Value & TextBox5.Value & TextBox6.Value
Cells(Rc, Sc).AddComment ComS
Cells(Rc, Sc).Comment.Visible = False

End Sub

Private Sub CommandButton2_Click()

ComboBox1.Value = ""
TextBox1.Value = "A:"
TextBox2.Value = "B:"
TextBox3.Value = "C:"
TextBox4.Value = "D:"
TextBox5.Value = "E:"
TextBox6.Value = "F:"

End Sub

【45948】Re:暦を作り、コメントをいれるには
発言  へっぽこ  - 07/1/18(木) 15:34 -

引用なし
パスワード
   「こんな感じ?」というものを作ってみました。
でも「コメント→フォーム」と間違えて「フォーム→コメント」を押すと
いきなり反映(場合によっては、いきなりコメント削除)されてしまい
使い勝手が良くないかもしれませんね。

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.6個あるテキストボックスの内容を改行(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 '自動サイズ調整ON
    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

コメントをいっぱい書いたのでいろいろ研究してみてくださいませ。

【45950】Re:暦を作り、コメントをいれるには
お礼  にしもり  - 07/1/18(木) 16:24 -

引用なし
パスワード
   ▼へっぽこ さん:
早速のご回答ありがとうございます。
希望どおりになりました。
また、丁寧なコメントをいれてくださり、おかげでよく理解できます。
心より感謝します。
ありがとうございました。

6319 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free