[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『文字が入っていればaddcomment』（ピッコロ大好き）
初心者です。過去ログ見ましたが似たものがなく質問させてください。
よろしくお願いします。
例えばB1に文字があればA1に"Bにコメントあり"とコメントを挿入。
B2とC2に文字があればA2に"Bにコメントあり"改行して"Cにコメントあり"と二行でコメントを挿入。
B列とC列に何も文字がなければ同じA列には何も表示しない。
同じ行のB、C列を参照して文字があれば同じ行のAにコメントをaddcommentで挿入したいのですが、うまくいきません。
もし可能であれば、オートシェイプで☆型でサイズを整えれたら嬉しいですが、それは可能であればで構いません。
よろしくお願い致します。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
>ピッコロ大好き さん
こんな感じのことが、したいのでしょうか？
>もし可能であれば、オートシェイプで☆型でサイズを整えれたら嬉しいですが .AutoShapeType = msoShapeRoundedRectangle の部分を .AutoShapeType = msoShape5pointStar 'オートシェイプで☆型 と記述してください。
お好きなシートのコード記述欄に下記のコードをコピペしてください。 B列、C列の値が変わったら、該当行のA列にコメントを挿入します ※B列、C列に、スペースのみを入力した場合、文字がないもととみなします。
【 参考にしたサイト】 ■Ｅｘｃｅでお仕事 http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_030_020.html ■AutoShapeTypeプロパティの定数一覧 http://www.relief.jp/itnote/archives/018476.php ■VBAでExcelのコメントを一括で自動サイズにしてカッコよくする http://techoh.net/customize-excel-comment-by-vba/ ************************************************************************* Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRng As Range, c As Range
Set myRng = Application.Intersect(Target, Range("B:C"))
If myRng Is Nothing Then Exit Sub
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim strTEXT As String, AA As Range, BB As Range, CC As Range
For Each c In Target
Set AA = c.EntireRow.Range("A1")
Set BB = c.EntireRow.Range("B1")
Set CC = c.EntireRow.Range("C1")
If Len(Trim(BB.Value)) <> 0 And Len(Trim(CC.Value)) = 0 Then
strTEXT = BB.Address(False, False) & " にコメントあり"
Call コメント挿入(AA, strTEXT)
ElseIf Len(Trim(BB.Value)) <> 0 And Len(Trim(CC.Value)) <> 0 Then
strTEXT = BB.Address(False, False) & " にコメントあり" & vbCrLf & _
CC.Address(False, False) & " にコメントあり"
Call コメント挿入(AA, strTEXT)
Else
If Not AA.Comment Is Nothing Then AA.ClearComments
End If
Next c
Set myRng = Nothing
Set AA = Nothing: Set BB = Nothing: Set CC = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Private Sub コメント挿入(ByVal AA As Range, ByVal strTEXT As String)
'A列該当行にコメントがあれば、削除
If Not AA.Comment Is Nothing Then AA.ClearComments
'A列該当行にコメントを挿入
AA.AddComment strTEXT
With AA.Comment.Shape
.TextFrame.AutoSize = True
.AutoShapeType = msoShapeRoundedRectangle
'.AutoShapeType = msoShape5pointStar 'オートシェイプで☆型
.Line.Weight = 1.5 '太さ
.Line.ForeColor.RGB = RGB(99, 99, 99) '枠線の色
.Fill.ForeColor.RGB = RGB(240, 240, 240) '塗りつぶし色
.Shadow.Transparency = 0.3
.Shadow.OffsetX = 1
.Shadow.OffsetY = 1
.TextFrame.Characters.Font.Bold = False
.TextFrame.HorizontalAlignment = xlHAlignLeft '左に寄せる
.Placement = xlMove ' セルに合わせて移動
End With
End Sub
（マリオ） 2017/02/20(月) 19:43
マリオさんに教えていただいた上記コードを使用すると、ｃ列のみに文字を入力した場合にA列にコメントが表示されません。
C列のみでもA列にコメント表示するにはどう書き換えればようでしょうか？
（B列のみ＆B列+C列に文字が入力されていれば現行きちんとA列にコメント表示されています）
よろしくお願いします。
（ピッコロ大好き） 2017/02/21(火) 15:29
>ピッコロ大好き さん
>マリオさんに教えていただいた上記コードを使用すると、ｃ列のみに文字を入力した場合にA列にコメントが表示されません。
はじめの質問内容にない【後だし条件】ですね。 「されません」といきなり言われましてもね、…。はー。 今、はじめてみる条件ですからね。
ちょっとは、自分で考えてみなさい！ If Len(Trim(BB.Value)) <> 0 And Len(Trim(CC.Value)) = 0 Then と ElseIf Len(Trim(BB.Value)) <> 0 And Len(Trim(CC.Value)) <> 0 Then の間に、新規でElseIf文を追加してみようという視点で考えてみてください。 なんとなくでも、意味が分かれば記述できるはずです。
***************************************************************
If Len(Trim(BB.Value)) <> 0 And Len(Trim(CC.Value)) = 0 Then
strTEXT = BB.Address(False, False) & " にコメントあり"
Call コメント挿入(AA, strTEXT)
***************************************************************
の3行をアレンジして、新規でElseIf文を追加してみてください。
さらに、ヒント！【BB.Address】ではなく、【CC.Address】で、
Call コメント挿入(AA, strTEXT)は、そのまま！
（マリオ） 2017/02/21(火) 15:49
こんばんわ。
ちょっと本題とは外れますけど、 >セキュリティをすべてのマクロを有効にしても動作しません、 今すぐ元に戻しましょう。 全てを有効にしたらウィルスに対して無防備過ぎます。
まだ外なので正確じゃ無いけど、元の設定でもマクロを有効にしますか、 みたいな警告は無かったですか？
（sy） 2017/02/21(火) 22:11
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.