Sub ResetComments()
Dim cmt As Comment
'すべてのコメントをループして削除する
For Each cmt In ActiveSheet.Comments
cmt.Delete
Next cmt
End Sub
'//---------------------------------------------------------------
'エクセルの行と列を入れ変えたシートを作る(行列入れ替え)
'---------------------------------------------------------------//
Sub 行と列を入れ変えたシートを作る()
ActiveSheet.UsedRange.Copy
Worksheets.Add
ActiveSheet.Range("A1").PasteSpecial Transpose:=True
End Sub
'//---------------------------------------------------------------
'エクセルのコメントサイズ自動調整
'---------------------------------------------------------------//
Sub コメントサイズ自動調整()
Dim bCommentVisible As Boolean
Dim cmt As Comment
Dim rng As Range
With Application ' 画面チラチラ防止
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
bCommentVisible = Not bCommentVisible
For Each cmt In ActiveSheet.Comments
cmt.Shape.TextFrame.AutoSize = True
'cmt.Shape.TextFrame.Characters.Font.Size = 11
Set rng = cmt.Parent ' 該当Cells
With cmt.Shape ' コメント位置の調整
.Left = rng.MergeArea.Left + rng.MergeArea.Width + 10
.Top = rng.Top - 10
End With
cmt.Visible = bCommentVisible
Next
With Application ' 画面チラチラ解除
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
'//---------------------------------------------------------------
'アクティブシートのコメント一覧を作成する
'---------------------------------------------------------------//
Sub コメント一覧()
Dim sh As Worksheet
Dim i As Integer
Dim c
Set sh = ActiveSheet
i = 0
Sheets.Add.Name = "コメント一覧-" & sh.Name
Cells(1, 1) = "コメント一覧-" & sh.Name
Cells(4, 2) = "行"
Cells(4, 3) = "列"
Cells(4, 4) = "作成者"
Cells(4, 5) = "コメント内容"
For Each c In sh.Comments
Cells(i + 5, 2) = c.Parent.row
Cells(i + 5, 3) = c.Parent.Column
Cells(i + 5, 4) = c.Author
Cells(i + 5, 5) = c.Text
i = i + 1
Next c
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
End Sub
'//---------------------------------------------------------------
'コメントメンテ
'アクティブシートのコメント一覧を使用して
'コメントを再設定
'実行前にコメント一覧のシートを表示させておく
'---------------------------------------------------------------//
Sub コメントメンテ()
Dim findPatern
findPatern = "コメント一覧*"
' コメントメンテする対象コメント一覧*が設定されていない
If Not ActiveWorkbook.ActiveSheet.Cells(1, 1).Value Like findPatern Then
MsgBox "コメント一覧を作成してからコメントメンテ作業してください"
Exit Sub
End If
Dim sh As Worksheet
Dim sh_name As String
Dim i As Integer
sh_name = Mid(Cells(1, 1), InStr(Cells(1, 1), "-") + 1, Len(Cells(1, 1)))
Set sh = Sheets(sh_name)
For i = 5 To Cells(4, 2).End(xlDown).row
sh.Cells(Cells(i, 2), Cells(i, 3)).ClearComments
With sh.Cells(Cells(i, 2), Cells(i, 3)).AddComment
.Visible = False
.Text Text:="作成者: " & CStr(Cells(i, 4)) & vbNewLine & CStr(Cells(i, 5))
'.Text Text:=CStr(Cells(i, 5))
End With
Next i
Call コメントサイズ自動調整
End Sub
'//---------------------------------------------------------------
'コメントの表示/非表示の切り替える
'---------------------------------------------------------------//
Sub コメントの表示非表示切替()
'①コメントとコメントマークを表示
Application.DisplayCommentIndicator = xlCommentAndIndicator
'②コメントマークのみ表示
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
'③コメントとコメントマークを表示しない
Application.DisplayCommentIndicator = xlNoIndicator
End Sub
