セルのコメントもVBAから動的に追加・変更できます。
少し遊んでもみました。
このページは長い間更新をしておらず、最初のサンプルコードだけでしたが、よく見るとコメントをいちいちSelectして書式を設定している記述だったので、
これを直そうと思ったのですが、ついでなのでコメントが「図形」だということを利用して、少し「いたずら」をやってみたのが3番目のサンプルです。
以前は手操作でも、コメントを選択して「図形の調整」「オートシェイプの変更」を行なえばできることなのですが、どうやらExcel2007以降ではマクロを作成しないとできなくなってしまったということです。
以前は手操作でも、コメントを選択して「図形の調整」「オートシェイプの変更」を行なえばできることなのですが、どうやらExcel2007以降ではマクロを作成しないとできなくなってしまったということです。
- セルのコメントもVBAから動的に変更できます。
-
サンプルは、A1セルのWorksheet_Changeイベントでコメントを書き換えています。
(画像をクリックすると、このサンプルがダウンロードできます)
このサンプルでは、セルの内容をコメント上に表示させています。
このマクロは、ワークシート上でセル内容が変わったことのイベントで動作させます。このため、「Worksheet_Change」のイベント処理を使います。
セルのコメントは、元々あるかどうかが不明なので、一旦追加する方法で記述しています。既にある場合は一旦エラーになるので、エラー処理側でコメントの文字列を変更させています。'*************************************************************************************************** ' セルのコメントをマクロで変更 Sheet1(Class) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '03/07/15(1.00)新規作成 '07/03/04(1.01)初回修正 '20/02/21(1.10)*.xlsm化、他 '*************************************************************************************************** Option Explicit '*************************************************************************************************** ' ■■■ ワークシートイベント ■■■ '*************************************************************************************************** '* 処理名 ：Worksheet_Change '* 機能 ：セル値変更イベント '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = Target(Range) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2003年07月15日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月21日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub Worksheet_Change(ByVal Target As Range) '----------------------------------------------------------------------------------------------- Const cnsRange As String = "$A$1" ' A1形式での該当Address Dim strText As String ' コメントテキストWork ' このサンプルではA1セル以外は処理なしとします。 If Target.Address <> cnsRange Then Exit Sub ' コメントの文字列を編集 strText = "A1セルの内容は、" & Range(cnsRange).Value & " です。" On Error Resume Next ' コメントを追加 ※既にコメントがあるとエラー処理に進む Range(cnsRange).AddComment strText ' エラーがあれば既にコメントがあるものとして処理 If Err.Number <> 0 Then ' 既にコメントがある場合はその文字列を変更 Range(cnsRange).Comment.Text strText End If On Error GoTo 0 ' コメントを表示(常時表示) Range(cnsRange).Comment.Visible = True ' セルを選択した上でコメントを選択 Range(cnsRange).Select ' コメントの書式セット Selection.Comment.Shape.Select True Selection.Font.ColorIndex = 5 ' 青文字 Selection.AutoSize = True ' AutoSize ' コメントを非表示する(ポイント持のみ表示) Range(cnsRange).Comment.Visible = False End Sub '----------------------------------------<< End of Source >>----------------------------------------
追加の場合は、書式が標準状態になるので、ここでは追加・変更にかかわらず、書式を再設定させています。
- 少し改良してみましょう。
-
上のサンプルだと、コメント自体を選択(Select)して書式を設定しているので、セル値の置き換えてTabキーやEnterキーを押しても選択セルが移動しません。
では、こちらではどうでしょうか。
(画像をクリックすると、このサンプルがダウンロードできます)
こちらは、コメント自体を選択(Select)しないで書式を設定しているので、通常通りセル移動します。
このように、SelectやSelectionの記述はありません。'*************************************************************************************************** ' セルのコメントをマクロで変更② Sheet1(Class) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '03/07/15(1.00)新規作成 '07/03/04(1.01)初回修正 '20/02/21(1.10)*.xlsm化、他 '*************************************************************************************************** Option Explicit '*************************************************************************************************** ' ■■■ ワークシートイベント ■■■ '*************************************************************************************************** '* 処理名 ：Worksheet_Change '* 機能 ：セル値変更イベント '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = Target(Range) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2003年07月15日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月21日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub Worksheet_Change(ByVal Target As Range) '----------------------------------------------------------------------------------------------- Const cnsRange As String = "$A$1" ' A1形式での該当Address Dim strText As String ' コメントテキストWork ' このサンプルではA1セル以外は処理なしとします。 If Target.Address <> cnsRange Then Exit Sub ' コメントの文字列を編集 strText = "A1セルの内容は、" & Range(cnsRange).Value & " です。" ' 指定セル With Range(cnsRange) On Error Resume Next ' コメントを追加 .AddComment strText ' コメント追加がエラーだったら｢既にある｣と判断 If Err.Number <> 0 Then Err.Clear ' コメントの文字列を変更 .Comment.Text strText End If On Error GoTo 0 ' コメントの書式セット With .Comment .Visible = True With .Shape.TextFrame .Characters.Font.Bold = True ' 太字 .Characters.Font.ColorIndex = 5 ' 青文字 .AutoSize = True ' AutoSize End With .Visible = False End With End With End Sub '----------------------------------------<< End of Source >>----------------------------------------
- コメントの形を変えてみましょう。
-
コメントは「図形」の一種なのでしょうか。オートシェイプと同様に形やグラデーションを指定することができます。
このように視覚効果はバツグンです。
コードは、上のものに数行加えるだけで良いのですが、図形の種類などの定数名（名前付き定数）がたくさんあるので、紹介するためにコメントにして追加してあります。
このように4つの変数を追加して、名前付き定数をセットしていますが、図形の種類や塗りつぶし方法が決まっているなら、1つ前のサンプルコードに、 「PresetGradient」メソッドと、「AutoShapeType」プロパティの2行を直接、名前付き定数を指定する(当然、定数値でも良い)だけです。'*************************************************************************************************** ' セルのコメントをマクロで変更③ Sheet1(Class) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '03/07/15(1.00)新規作成 '07/03/04(1.01)初回修正 '20/02/21(1.10)*.xlsm化、他 '*************************************************************************************************** Option Explicit '*************************************************************************************************** ' ■■■ ワークシートイベント ■■■ '*************************************************************************************************** '* 処理名 ：Worksheet_Change '* 機能 ：セル値変更イベント '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = Target(Range) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2003年07月15日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月21日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub Worksheet_Change(ByVal Target As Range) '----------------------------------------------------------------------------------------------- Const cnsRange As String = "$A$1" ' A1形式での該当Address Dim lngG_Style As Long ' グラデーションの種類 Dim lngVariant As Long ' バリエーション Dim lngPG_Type As Long ' 既定のグラデーション Dim lngAutoShapeType As Long ' 図形の種類 Dim strText As String ' コメントテキストWork ' このサンプルではA1セル以外は処理なしとします。 If Target.Address <> cnsRange Then Exit Sub '--------------------------------------------------------------------------- ' コメントの文字列を編集 strText = "A1セルの内容は、" & Range(cnsRange).Value & " です。" ' 塗りつぶし方法の設定 Call GP_GetGradient(lngG_Style, lngVariant, lngPG_Type) ' 図形の種類の設定 Call GP_GetShapeType(lngAutoShapeType) '--------------------------------------------------------------------------- ' 実際のコメント処理 With Range(cnsRange) On Error Resume Next ' コメントを追加 .AddComment strText ' コメント追加がエラーだったら｢既にある｣と判断 If Err.Number <> 0 Then Err.Clear ' コメントの文字列を変更 .Comment.Text strText End If On Error GoTo 0 ' コメントの書式セット With .Comment .Visible = True With .Shape With .TextFrame .Characters.Font.Bold = True ' 太字 .Characters.Font.ColorIndex = 5 ' 青文字 .AutoSize = True ' AutoSize End With ' グラデーションの指定 .Fill.PresetGradient lngG_Style, lngVariant, lngPG_Type ' 図形の種類の指定 .AutoShapeType = lngAutoShapeType End With .Visible = False End With End With End Sub '*************************************************************************************************** ' ■■■ サブ処理(Private) ■■■ '*************************************************************************************************** '* 処理名 ：GP_GetGradient '* 機能 ：塗りつぶし方法の設定 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = コメント塗りつぶしのグラデーションの種類(Long) ※Ref参照 '* ：Arg2 = コメント塗りつぶしのバリエーション(Long) ※Ref参照 '* ：Arg3 = 既定のグラデーション(Long) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2003年07月15日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月21日 '* 更新者 ：井上 治 '* 機能説明：下記の３種類それぞれでどれか１行だけを有効にして下さい。 '* 注意事項： '*************************************************************************************************** Private Sub GP_GetGradient(ByRef lngG_Style As Long, _ ByRef lngVariant As Long, _ ByRef lngPG_Type As Long) '----------------------------------------------------------------------------------------------- ' コメント塗りつぶしのグラデーションの種類 ' lngG_Style = msoGradientDiagonalDown ' lngG_Style = msoGradientDiagonalUp ' lngG_Style = msoGradientFromCenter ' lngG_Style = msoGradientFromCorner lngG_Style = msoGradientHorizontal ' lngG_Style = msoGradientVertical '--------------------------------------------------------------------------- ' コメント塗りつぶしのバリエーション lngVariant = 1 ' lngVariant = 2 ' lngVariant = 3 ' lngVariant = 4 '--------------------------------------------------------------------------- ' 既定のグラデーション ' lngPG_Type = msoGradientBrass lngPG_Type = msoGradientCalmWater ' lngPG_Type = msoGradientChrome ' lngPG_Type = msoGradientChromeII ' lngPG_Type = msoGradientDaybreak ' lngPG_Type = msoGradientDesert ' lngPG_Type = msoGradientEarlySunset ' lngPG_Type = msoGradientFire ' lngPG_Type = msoGradientFog ' lngPG_Type = msoGradientGold ' lngPG_Type = msoGradientGoldII ' lngPG_Type = msoGradientHorizon ' lngPG_Type = msoGradientLateSunset ' lngPG_Type = msoGradientMahogany ' lngPG_Type = msoGradientMoss ' lngPG_Type = msoGradientNightfall ' lngPG_Type = msoGradientOcean ' lngPG_Type = msoGradientParchment ' lngPG_Type = msoGradientPeacock ' lngPG_Type = msoGradientRainbow ' lngPG_Type = msoGradientRainbowII ' lngPG_Type = msoGradientSapphire ' lngPG_Type = msoGradientSilver ' lngPG_Type = msoGradientWheat ' lngPG_Type = msoPresetGradientMixed End Sub '*************************************************************************************************** '* 処理名 ：GP_GetShapeType '* 機能 ：図形の種類の設定 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 図形の種類(Long) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2003年07月15日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月21日 '* 更新者 ：井上 治 '* 機能説明：下記のどれか１行だけを有効にして下さい。 '* 注意事項： '*************************************************************************************************** Private Sub GP_GetShapeType(ByRef lngAutoShapeType) '----------------------------------------------------------------------------------------------- ' lngAutoShapeType = msoShape16pointStar ' lngAutoShapeType = msoShape24pointStar ' lngAutoShapeType = msoShape32pointStar ' lngAutoShapeType = msoShape4pointStar ' lngAutoShapeType = msoShape5pointStar ' lngAutoShapeType = msoShape8pointStar ' lngAutoShapeType = msoShapeActionButtonBackorPrevious ' lngAutoShapeType = msoShapeActionButtonBeginning ' lngAutoShapeType = msoShapeActionButtonCustom ' lngAutoShapeType = msoShapeActionButtonDocument ' lngAutoShapeType = msoShapeActionButtonEnd ' lngAutoShapeType = msoShapeActionButtonForwardorNext ' lngAutoShapeType = msoShapeActionButtonHelp ' lngAutoShapeType = msoShapeActionButtonHome ' lngAutoShapeType = msoShapeActionButtonInformation ' lngAutoShapeType = msoShapeActionButtonMovie ' lngAutoShapeType = msoShapeActionButtonReturn ' lngAutoShapeType = msoShapeActionButtonSound ' lngAutoShapeType = msoShapeArc ' lngAutoShapeType = msoShapeBalloon ' lngAutoShapeType = msoShapeBentArrow ' lngAutoShapeType = msoShapeBentUpArrow ' lngAutoShapeType = msoShapeBevel ' lngAutoShapeType = msoShapeBlockArc ' lngAutoShapeType = msoShapeCan ' lngAutoShapeType = msoShapeChevron ' lngAutoShapeType = msoShapeCircularArrow ' lngAutoShapeType = msoShapeCloudCallout ' lngAutoShapeType = msoShapeCross ' lngAutoShapeType = msoShapeCube ' lngAutoShapeType = msoShapeCurvedDownArrow ' lngAutoShapeType = msoShapeCurvedDownRibbon ' lngAutoShapeType = msoShapeCurvedLeftArrow ' lngAutoShapeType = msoShapeCurvedRightArrow ' lngAutoShapeType = msoShapeCurvedUpArrow ' lngAutoShapeType = msoShapeCurvedUpRibbon ' lngAutoShapeType = msoShapeDiamond ' lngAutoShapeType = msoShapeDonut ' lngAutoShapeType = msoShapeDoubleBrace ' lngAutoShapeType = msoShapeDoubleBracket ' lngAutoShapeType = msoShapeDoubleWave ' lngAutoShapeType = msoShapeDownArrow ' lngAutoShapeType = msoShapeDownArrowCallout ' lngAutoShapeType = msoShapeDownRibbon ' lngAutoShapeType = msoShapeExplosion1 lngAutoShapeType = msoShapeExplosion2 ' lngAutoShapeType = msoShapeFlowchartAlternateProcess ' lngAutoShapeType = msoShapeFlowchartCard ' lngAutoShapeType = msoShapeFlowchartCollate ' lngAutoShapeType = msoShapeFlowchartConnector ' lngAutoShapeType = msoShapeFlowchartData ' lngAutoShapeType = msoShapeFlowchartDecision ' lngAutoShapeType = msoShapeFlowchartDelay ' lngAutoShapeType = msoShapeFlowchartDirectAccessStorage ' lngAutoShapeType = msoShapeFlowchartDisplay ' lngAutoShapeType = msoShapeFlowchartDocument ' lngAutoShapeType = msoShapeFlowchartExtract ' lngAutoShapeType = msoShapeFlowchartInternalStorage ' lngAutoShapeType = msoShapeFlowchartMagneticDisk ' lngAutoShapeType = msoShapeFlowchartManualInput ' lngAutoShapeType = msoShapeFlowchartManualOperation ' lngAutoShapeType = msoShapeFlowchartMerge ' lngAutoShapeType = msoShapeFlowchartMultidocument ' lngAutoShapeType = msoShapeFlowchartOffpageConnector ' lngAutoShapeType = msoShapeFlowchartOr ' lngAutoShapeType = msoShapeFlowchartPredefinedProcess ' lngAutoShapeType = msoShapeFlowchartPreparation ' lngAutoShapeType = msoShapeFlowchartProcess ' lngAutoShapeType = msoShapeFlowchartPunchedTape ' lngAutoShapeType = msoShapeFlowchartSequentialAccessStorage ' lngAutoShapeType = msoShapeFlowchartSort ' lngAutoShapeType = msoShapeFlowchartStoredData ' lngAutoShapeType = msoShapeFlowchartSummingJunction ' lngAutoShapeType = msoShapeFlowchartTerminator ' lngAutoShapeType = msoShapeFoldedCorner ' lngAutoShapeType = msoShapeHeart ' lngAutoShapeType = msoShapeHexagon ' lngAutoShapeType = msoShapeHorizontalScroll ' lngAutoShapeType = msoShapeIsoscelesTriangle ' lngAutoShapeType = msoShapeLeftArrow ' lngAutoShapeType = msoShapeLeftArrowCallout ' lngAutoShapeType = msoShapeLeftBrace ' lngAutoShapeType = msoShapeLeftBracket ' lngAutoShapeType = msoShapeLeftRightArrow ' lngAutoShapeType = msoShapeLeftRightArrowCallout ' lngAutoShapeType = msoShapeLeftRightUpArrow ' lngAutoShapeType = msoShapeLeftUpArrow ' lngAutoShapeType = msoShapeLightningBolt ' lngAutoShapeType = msoShapeLineCallout1 ' lngAutoShapeType = msoShapeLineCallout1AccentBar ' lngAutoShapeType = msoShapeLineCallout1BorderandAccentBar ' lngAutoShapeType = msoShapeLineCallout1NoBorder ' lngAutoShapeType = msoShapeLineCallout2 ' lngAutoShapeType = msoShapeLineCallout2AccentBar ' lngAutoShapeType = msoShapeLineCallout2BorderandAccentBar ' lngAutoShapeType = msoShapeLineCallout2NoBorder ' lngAutoShapeType = msoShapeLineCallout3 ' lngAutoShapeType = msoShapeLineCallout3AccentBar ' lngAutoShapeType = msoShapeLineCallout3BorderandAccentBar ' lngAutoShapeType = msoShapeLineCallout3NoBorder ' lngAutoShapeType = msoShapeLineCallout4 ' lngAutoShapeType = msoShapeLineCallout4AccentBar ' lngAutoShapeType = msoShapeLineCallout4BorderandAccentBar ' lngAutoShapeType = msoShapeLineCallout4NoBorder ' lngAutoShapeType = msoShapeMixed ' lngAutoShapeType = msoShapeMoon ' lngAutoShapeType = msoShapeNoSymbol ' lngAutoShapeType = msoShapeNotchedRightArrow ' lngAutoShapeType = msoShapeNotPrimitive ' lngAutoShapeType = msoShapeOctagon ' lngAutoShapeType = msoShapeOval ' lngAutoShapeType = msoShapeOvalCallout ' lngAutoShapeType = msoShapeParallelogram ' lngAutoShapeType = msoShapePentagon ' lngAutoShapeType = msoShapePlaque ' lngAutoShapeType = msoShapeQuadArrow ' lngAutoShapeType = msoShapeQuadArrowCallout ' lngAutoShapeType = msoShapeRectangle ' lngAutoShapeType = msoShapeRectangularCallout ' lngAutoShapeType = msoShapeRegularPentagon ' lngAutoShapeType = msoShapeRightArrow ' lngAutoShapeType = msoShapeRightArrowCallout ' lngAutoShapeType = msoShapeRightBrace ' lngAutoShapeType = msoShapeRightBracket ' lngAutoShapeType = msoShapeRightTriangle ' lngAutoShapeType = msoShapeRoundedRectangle ' lngAutoShapeType = msoShapeRoundedRectangularCallout ' lngAutoShapeType = msoShapeSmileyFace ' lngAutoShapeType = msoShapeStripedRightArrow ' lngAutoShapeType = msoShapeSun ' lngAutoShapeType = msoShapeTrapezoid ' lngAutoShapeType = msoShapeUpArrow ' lngAutoShapeType = msoShapeUpArrowCallout ' lngAutoShapeType = msoShapeUpDownArrow ' lngAutoShapeType = msoShapeUpDownArrowCallout ' lngAutoShapeType = msoShapeUpRibbon ' lngAutoShapeType = msoShapeUTurnArrow ' lngAutoShapeType = msoShapeVerticalScroll ' lngAutoShapeType = msoShapeWave End Sub '----------------------------------------<< End of Source >>----------------------------------------
- コメントの文字の一部の色を変えてみましょう。
-
コメントの中に埋め込まれたセルの文字列部分だけを赤字にするサンプルです。
さらに今回は応用しやすいようにコメント処理部分をプロシージャを分けてみました。
「GP_SetCellComment」は最低、該当セルとコメントの表示文字列を渡せば動作でき、青太字は固定としています。'*************************************************************************************************** ' セルのコメントをマクロで変更④ ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** ' 変更日付 Rev 変更履歴内容----------------------------------------------------------------------> ' 17/02/12(1.0.0)新規作成 ' 17/02/13(1.1.0)セル値消去時の対応を追加 '*************************************************************************************************** Option Explicit '*************************************************************************************************** ' ■■■ Worksheetイベント ■■■ '*************************************************************************************************** '* 処理名 ： '* 機能 ：WorksheetのChangeイベント '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 対象セル(Range) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月12日 '* 作成者 ：井上 治 '* 更新日 ：2017年02月13日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub Worksheet_Change(ByVal Target As Range) '----------------------------------------------------------------------------------------------- Const cnsRange1 = "$A$1" ' 対象セルAddress① Const cnsRange2 = "$C$4" ' 対象セルAddress② Dim strCommentText As String ' コメントテキスト ' このサンプルでは上記設定セル以外は処理なしとします。 If ((Target.Address <> cnsRange1) And (Target.Address <> cnsRange2)) Then Exit Sub ' コメントの文字列を編集 If Target.Value <> "" Then strCommentText = "セルの内容は、" & Target.Value & " です。" End If Application.ScreenUpdating = False ' 画面描画停止 ' セルコメントの設定 Call GP_SetCellComment(Target, strCommentText, 8, Len(Target.Value)) 'Call GP_SetCellComment(Target, strCommentText, 8) Application.ScreenUpdating = True ' 画面描画再開 End Sub '*************************************************************************************************** ' ■■■ サブ処理 ■■■ '*************************************************************************************************** '* 処理名 ：GP_SetCellComment '* 機能 ：セルコメントの設定 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 対象セル(Object) '* Arg2 = コメントテキスト(String) '* Arg3 = 赤字開始文字列位置(Integer) ※Oprion '* Arg4 = 赤字文字数(Integer) ※Option '--------------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月12日 '* 作成者 ：井上 治 '* 更新日 ：2017年02月13日 '* 更新者 ：井上 治 '* 機能説明：オプションの指定で文字列の一部を赤字に変更可 '* 注意事項：赤字文字数指定がない時は開始文字位置以降全てが赤字となる '*************************************************************************************************** Private Sub GP_SetCellComment(ByRef objRange As Range, _ ByVal strCommentText As String, _ Optional ByVal intRedStart As Integer = -1, _ Optional ByVal intRedLength As Integer = -1) '----------------------------------------------------------------------------------------------- With objRange.Cells(1) ' コメント文字列が未指定の時は消去 If strCommentText = "" Then .ClearComments Exit Sub End If On Error Resume Next .AddComment strCommentText ' コメント追加がエラーだったら｢既にある｣と判断して現在のコメントの表示を変更 If Err.Number <> 0 Then Err.Clear .Comment.Text strCommentText End If On Error GoTo 0 ' コメントの書式セット With .Comment .Visible = True With .Shape.TextFrame .Characters.Font.Bold = True ' 太字 .Characters.Font.ColorIndex = 5 ' 青字 ' 文字列の一部を赤字に変更する If intRedStart > 0 Then ' 文字数指定がある If intRedLength > 0 Then .Characters(intRedStart, intRedLength).Font.ColorIndex = 3 ' 赤字 Else ' 文字数指定がない時は以降全て .Characters(intRedStart, _ Len(strCommentText) - intRedStart + 1).Font.ColorIndex = 3 End If End If .AutoSize = True ' AutoSize End With .Visible = False End With End With End Sub '------------------------------------------<< End of Source >>--------------------------------------
一部を赤字にしたい場合は、赤字にする開始文字位置(このサンプルでは8文字目)と赤字にする文字数を引数に追加します。
開始文字位置だけで文字数の指定をしない場合は、開始文字位置から後ろ全てが赤字になります。