[[20220413130104]]　『文字の上にレ点を入れたい』（むむむ）　ページの最後に飛ぶ

『文字の上にレ点を入れたい』（むむむ）

はじめまして。

仮にセルc9にokという文字が入っているとします。
ダブルクリックをしたらそのokという文字の上にレ点を入れるのは可能でしょうか？
基本セルは上下中央揃えです。

VBAでレ点を入れられるコードはあったのですが
実行すると文字が消えてしまいました。

どうかご教示願います。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

こういうことでしょうか？

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

 With Target
  If .Value = "OK" Then
   .Phonetics.Visible = True
   .Characters(1, 2).PhoneticCharacters = "レ"
  End If
 End With
End Sub
（蒸かし芋） 2022/04/13(水) 13:12

 >.Characters(1, 2).PhoneticCharacters = "レ"

 ↓に修正してください。

 Characters(1, 2).PhoneticCharacters = ChrW("&H" & 2714)
（蒸かし芋） 2022/04/13(水) 13:17

蒸かし芋さん
ご教示ありがとうございました。
説明不足だったのですが
文字の上の認識の違いだと思うのですが
ご教示いただいたコードで実行すると
okの真上にレ点がつきました。
私の中の文字の上はokと重なるという意味で書きました。
すみませんでした。
もう一度ご教示願います。
（むむむ） 2022/04/13(水) 13:42

 テキストボックスを乗っけるとか?

    Sub チェックマーク貼付()
        If ActiveSheet Is Nothing Then Exit Sub
        If ActiveSheet.ProtectDrawingObjects Then Exit Sub
        Dim a As Range
        Set a = ActiveCell
        With ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, a.Left, a.Top, 0#, 0#)
            With .TextFrame
                .Characters.Text = ChrW(10003)
                .Characters.Font.Color = &HFF&
                .Characters.Font.Size = a.Font.Size
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .MarginLeft = 0
                .MarginTop = 0
                .MarginRight = 0
                .MarginBottom = 0
                .AutoSize = True
            End With
            .Left = a.Left + a.Width / 2 - .Width / 2
            .Top = a.Top + a.Height / 2 - .Height / 2
            .Select
        End With
    End Sub

（白茶） 2022/04/13(水) 14:33

 >ダブルクリックをしたらそのokという文字の上にレ点を入れる

 シートモジュールに
 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim objText As Object

    If Target.Value <> "ok" Then Exit Sub
    Set objText = ActiveSheet.Shapes.AddTextbox(1, 0, 0, 0, 0)
    With objText
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
        .TextFrame.Characters.Text = ChrW(&H2714)
        .TextFrame.AutoSize = msoAutoSizeShapeToFitText
        .TextFrame.HorizontalAlignment = xlHAlignCenter
        .TextFrame.VerticalAlignment = xlVAlignCenter
        .Left = Target.Left + (Target.Width - .Width) / 2
        .Top = Target.Top + (Target.Height - .Height) / 2
    End With
    Cancel = True
 End Sub

（ピンク） 2022/04/13(水) 15:25

白茶さん
ご教示ありがとうございます。
実行してみたところが
okのセルをダブルクリックしたらなぜかngのセルにレ点が入りました。
レ点の場所はらngのnとgの間の下に入りました。
（むむむ） 2022/04/13(水) 15:26

ピンクさん
ご教示ありがとうございます。
無事にできました。
最後に一つだけ質問させてください。
レ点の大きさは変えられますか？

（むむむ） 2022/04/13(水) 15:50

 >レ点の大きさは変えられますか？

        .TextFrame.Characters.Text = ChrW(&H2713) 	
        'フォントサイズ
        .TextFrame.Characters.Font.Size = 14                 'フォントサイズ					
        'フンォント色
        .TextFrame.Characters.Font.Color = vbRed            ' RGB(255, 0, 0)も可

（ピンク） 2022/04/13(水) 15:55

ピンクさん。
ご教示ありがとうございました。
無事にできました。
いろいろと勉強になりました。
（むむむ） 2022/04/13(水) 16:02

再度質問です。
ダブルクリックイベントではなくエンターキー押したら発生するイベントを探していたら
コナンさんが質問すていた「[20220419212018]]を参考にコードを組んでみました。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

        Static myRng1 As Range
        If Not myRng1 Is Nothing Then
            If GetAsyncKeyState(vbKeyReturn) And &H8000 = &H8000 Then myRng1.Value = "OK"
        End If
        Set myRng1 = Intersect(Target, Me.Range("C9:C28"))

         Static myRng2 As Range
        If Not myRng2 Is Nothing Then
            If GetAsyncKeyState(vbKeyReturn) And &H8000 = &H8000 Then myRng2.Value = "OK"
        End If
        Set myRng2 = Intersect(Target, Me.Range("G9:G28"))

          Static myRng3 As Range
        If Not myRng3 Is Nothing Then
            If GetAsyncKeyState(vbKeyReturn) And &H8000 = &H8000 Then myRng3.Value = "OK"
        End If
        Set myRng3 = Intersect(Target, Me.Range("I9:I28"))

        Static myRng4 As Range
        If Not myRng4 Is Nothing Then
            If GetAsyncKeyState(vbKeyReturn) And &H8000 = &H8000 Then myRng4.Value = "OK"
        End If
        Set myRng4 = Intersect(Target, Me.Range("O9:O28"))

        Static myRng5 As Range 'はんだ有無の有
        If Not myRng5 Is Nothing Then
            If GetAsyncKeyState(vbKeyReturn) And &H8000 = &H8000 Then
            Dim objText As Object
            Set objText = ActiveSheet.Shapes.AddTextbox(1, 0, 0, 0, 0)
    With objText
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
        .TextFrame.Characters.Text = ChrW(&H2714)
        .TextFrame.Characters.Font.Color = vbRed '色
        .TextFrame.Characters.Font.Size = 18  'サイズ
        .TextFrame.AutoSize = msoAutoSizeShapeToFitText
        .TextFrame.HorizontalAlignment = xlHAlignCenter
        .TextFrame.VerticalAlignment = xlVAlignCenter
        .Left = myRng5.Left + (myRng5.Width - .Width) / 2
        .Top = myRng5.Top + (myRng5.Height - .Height) / 2
    End With

     myRng5.Offset(0, 2).Select

    Cancel = True
    End If
        End If
     Set myRng5 = Intersect(Target, Me.Range("E9:E28"))

        Static myRng6 As Range 'はんだ有無の無
        If Not myRng6 Is Nothing Then
            If GetAsyncKeyState(vbKeyReturn) And &H8000 = &H8000 Then
            Dim objText2 As Object
            Set objText2 = ActiveSheet.Shapes.AddTextbox(1, 0, 0, 0, 0)
    With objText2
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
        .TextFrame.Characters.Text = ChrW(&H2714)
        .TextFrame.Characters.Font.Color = vbRed '色
        .TextFrame.Characters.Font.Size = 18  'サイズ
        .TextFrame.AutoSize = msoAutoSizeShapeToFitText
        .TextFrame.HorizontalAlignment = xlHAlignCenter
        .TextFrame.VerticalAlignment = xlVAlignCenter
        .Left = myRng6.Left + (myRng6.Width - .Width) / 2
        .Top = myRng6.Top + (myRng6.Height - .Height) / 2
    End With
     With myRng6.Offset(0, 1).Borders(xlDiagonalUp)
    .LineStyle = True
    .Weight = xlMedium
     .Color = vbRed
     End With
  With myRng6.Offset(0, 3).Borders(xlDiagonalUp)
    .LineStyle = True
    .Weight = xlMedium
     .Color = vbRed
     End With
  With myRng6.Offset(0, 5).Borders(xlDiagonalUp)
    .LineStyle = True
    .Weight = xlMedium
     .Color = vbRed
     End With
  With myRng6.Offset(0, 6).Borders(xlDiagonalUp)
    .LineStyle = True
    .Weight = xlMedium
     .Color = vbRed
     End With
        Cancel = True
    End If
        End If
    Set myRng6 = Intersect(Target, Me.Range("F9:F28"))

     Static myRng7 As Range 'ボンド有無の有
        If Not myRng7 Is Nothing Then
            If GetAsyncKeyState(vbKeyReturn) And &H8000 = &H8000 Then
            Dim objText3 As Object
            Set objText3 = ActiveSheet.Shapes.AddTextbox(1, 0, 0, 0, 0)
    With objText3
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
        .TextFrame.Characters.Text = ChrW(&H2714)
        .TextFrame.Characters.Font.Color = vbRed '色
        .TextFrame.Characters.Font.Size = 18  'サイズ
        .TextFrame.AutoSize = msoAutoSizeShapeToFitText
        .TextFrame.HorizontalAlignment = xlHAlignCenter
        .TextFrame.VerticalAlignment = xlVAlignCenter
        .Left = myRng7.Left + (myRng7.Width - .Width) / 2
        .Top = myRng7.Top + (myRng7.Height - .Height) / 2
    End With
     myRng7.Offset(0, 2).Select
    Cancel = True
    End If
        End If
    Set myRng7 = Intersect(Target, Me.Range("M9:M28"))

     Static myRng8 As Range 'ボンド有無の無
        If Not myRng8 Is Nothing Then
            If GetAsyncKeyState(vbKeyReturn) And &H8000 = &H8000 Then
            Dim objText4 As Object
            Set objText4 = ActiveSheet.Shapes.AddTextbox(1, 0, 0, 0, 0)
    With objText4
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
        .TextFrame.Characters.Text = ChrW(&H2714)
        .TextFrame.Characters.Font.Color = vbRed '色
        .TextFrame.Characters.Font.Size = 18  'サイズ
        .TextFrame.AutoSize = msoAutoSizeShapeToFitText
        .TextFrame.HorizontalAlignment = xlHAlignCenter
        .TextFrame.VerticalAlignment = xlVAlignCenter
        .Left = myRng8.Left + (myRng8.Width - .Width) / 2
        .Top = myRng8.Top + (myRng8.Height - .Height) / 2
    End With
     With myRng8.Offset(0, 1).Borders(xlDiagonalUp)
    .LineStyle = True
    .Weight = xlMedium
     .Color = vbRed
     End With
        Cancel = True
    End If
        End If
    Set myRng8 = Intersect(Target, Me.Range("N9:N28")

    End Sub
そこで1回目(9行目)を行っていくとE列にエンターキーを押すと文字の上にレ点が入り,G列に飛びます。G列にてエンターキーを押すとOKが入力されるのですが
なぜかE列10行目の文字の上のレ点が入ってしまいます。
２回目以降はG列にOKが入力されてもE列の文字の上にレ点は入りません。この動作が正常です。
なぜ1回目だけE列10行目の文字の上のレ点が入ってしまうのですか？
コードはいろいろ問題があると思いますが
簡潔にできるのなら教えてほしいです。
（むむむ） 2022/04/20(水) 22:19

 参考に
 Option Explicit
 Private Declare PtrSafe Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static myRng As Range
    Dim objText As Object
    If Not myRng Is Nothing And GetAsyncKeyState(vbKeyReturn) And &H8000 Then
        Select Case myRng.Column
            Case 3, 7, 9, 15
                myRng.Value = "OK"
            Case 5, 6, 13, 14
                Set objText = ActiveSheet.Shapes.AddTextbox(1, 0, 0, 0, 0)
                With objText
                    .Fill.Visible = msoFalse
                    .Line.Visible = msoFalse
                    .TextFrame.Characters.Text = ChrW(&H2714)
                    .TextFrame.Characters.Font.Color = vbRed '色
                    .TextFrame.Characters.Font.Size = 18  'サイズ
                    .TextFrame.AutoSize = msoAutoSizeShapeToFitText
                    .TextFrame.HorizontalAlignment = xlHAlignCenter
                    .TextFrame.VerticalAlignment = xlVAlignCenter
                    .Left = myRng.Left + (myRng.Width - .Width) / 2
                    .Top = myRng.Top + (myRng.Height - .Height) / 2
                End With
                Application.EnableEvents = False
                If myRng.Column = 5 Or myRng.Column = 13 Then
                    myRng.Offset(, 2).Select
                ElseIf myRng.Column = 6 Then
                    With Union(myRng.Cells(1, 2), myRng.Cells(1, 4), _
                            myRng.Cells(1, 6), myRng.Cells(1, 7)).Borders(xlDiagonalUp)
                        .LineStyle = True
                        .Weight = xlMedium
                        .Color = vbRed
                    End With
                ElseIf myRng.Column = 14 Then
                    With myRng.Offset(, 1).Borders(xlDiagonalUp)
                        .LineStyle = True
                        .Weight = xlMedium
                        .Color = vbRed
                    End With
                End If
                Application.EnableEvents = True

        End Select
    End If
    Set myRng = Intersect(Target, Me.Range("C9:C28,E9:G28,I9:I28,M9:O28"))
 End Sub
（ピンク） 2022/04/21(木) 10:03

ピンクさん
ご教授ありがとうございます。

頂いたコードで実行したところ
やはり症状としては変わりませんでした。
ちなみに、3, 7, 9, 15列目は横にセルの結合をしていますが、それが関係していますか？
あとStaticを使っているから値が初期化されてないとかですか？

（むむむ） 2022/04/21(木) 12:47

＞ちなみに、3, 7, 9, 15列目は横にセルの結合をしていますが、
これだけでは、どの列と、どの列がどこまで結合しているのか
私では判断てきませんので離脱させていただきます。

（ピンク） 2022/04/21(木) 13:00

ピンクさん
大事な部分を忘れて大変失礼しまさした。

3列目はCＤ列が結合
7列目はＧＨ列が結合
9列目はＩＪ列が結合
15列目はOP列が結合
です。
すみませんでした。
（むむむ） 2022/04/21(木) 13:57

 どうぞ～
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static myRng As Range
    Dim objText As Object
    If Not myRng Is Nothing And GetAsyncKeyState(vbKeyReturn) And &H8000 Then
        Select Case myRng.Column
            Case 3, 7, 9, 15
                myRng.Value = "OK"
            Case 5, 6, 13, 14
                Set objText = ActiveSheet.Shapes.AddTextbox(1, 0, 0, 0, 0)
                With objText
                    .Fill.Visible = msoFalse
                    .Line.Visible = msoFalse
                    .TextFrame.Characters.Text = ChrW(&H2714)
                    .TextFrame.Characters.Font.Color = vbRed '色
                    .TextFrame.Characters.Font.Size = 18  'サイズ
                    .TextFrame.AutoSize = msoAutoSizeShapeToFitText
                    .TextFrame.HorizontalAlignment = xlHAlignCenter
                    .TextFrame.VerticalAlignment = xlVAlignCenter
                    .Left = myRng.Left + (myRng.Width - .Width) / 2
                    .Top = myRng.Top + (myRng.Height - .Height) / 2
                End With
                If myRng.Column = 5 Or myRng.Column = 13 Then
                    Application.EnableEvents = False
                    Set myRng = myRng.Offset(, 2)
                    myRng.Select
                    Application.EnableEvents = True
                    Exit Sub
                ElseIf myRng.Column = 6 Then
                    With Union(myRng.Cells(1, 2), myRng.Cells(1, 4), _
                            myRng.Cells(1, 6), myRng.Cells(1, 7)).Borders(xlDiagonalUp)
                        .LineStyle = True
                        .Weight = xlMedium
                        .Color = vbRed
                    End With
                ElseIf myRng.Column = 14 Then
                    With myRng.Offset(, 1).Borders(xlDiagonalUp)
                        .LineStyle = True
                        .Weight = xlMedium
                        .Color = vbRed
                    End With
                End If
        End Select
    End If
    Set myRng = Intersect(Target, Me.Range("C9:C28,E9:G28,I9:I28,M9:O28"))
 End Sub

（ピンク） 2022/04/21(木) 15:51

ピンクさん。
ありがとうございました。
無事にできました。
イベントを抑制する場所を変えたって感じですか？
間違いだったらご容赦ください。
（むむむ） 2022/04/21(木) 16:55

ピンクさん
先日はありがとうございました。

今セルを選択した際に選択セルの背景色を色付けして分かりやすくしようとしています。

ネットを参考に以下のコードを追加しました。

 Static myRng As Range, myRng1 As Range, myColor As Long
    If Target.Count > 1 Or Target.Address = "$P$1" Then Exit Sub
    If Range("P1") = 1 Then
    If Not myRng1 Is Nothing Then
     myRng1.Interior.ColorIndex = myColor
     End If

     Set myRng1 = Target
     myColor = Target.Interior.ColorIndex
     Target.Interior.ColorIndex = 4
    End If

    Dim objText As Object
    If Not myRng Is Nothing And GetAsyncKeyState(vbKeyReturn) And &H8000 Then
        Select Case myRng.Column
            Case 3, 6, 7
                myRng.Value = "OK"

            Case 4, 5, 8, 9, 10, 11
                Set objText = ActiveSheet.Shapes.AddTextbox(1, 0, 0, 0, 0)
                With objText
                    .Fill.Visible = msoFalse
                    .Line.Visible = msoFalse
                    .TextFrame.Characters.Text = ChrW(&H2714)
                    .TextFrame.Characters.Font.Color = vbRed '色
                    .TextFrame.Characters.Font.Size = 18  'サイズ
                    .TextFrame.AutoSize = msoAutoSizeShapeToFitText
                    .TextFrame.HorizontalAlignment = xlHAlignCenter
                    .TextFrame.VerticalAlignment = xlVAlignCenter
                    .Left = myRng.Left + (myRng.Width - .Width) / 2
                    .Top = myRng.Top + (myRng.Height - .Height) / 2
                End With

                If myRng.Column = 4 Or myRng.Column = 8 Or myRng.Column = 10 Then
                Application.EnableEvents = False
                  Set myRng = myRng.Offset(, 2)
                   myRng.Select

                   Application.EnableEvents = True
                   Exit Sub
                ElseIf myRng.Column = 5 Then
                Application.EnableEvents = False

                    With Union(myRng.Cells(1, 2), myRng.Cells(1, 3), _
                            myRng.Cells(1, 4), myRng.Cells(1, 5)).Borders(xlDiagonalUp)
                        .LineStyle = True
                        .Weight = xlMedium
                        .Color = vbRed
                        Set myRng = myRng.Offset(, 5)
                     myRng.Select
                   Application.EnableEvents = True
                   Exit Sub
                    End With

                ElseIf myRng.Column = 11 Then 'K列
                    With myRng.Offset(, 1).Borders(xlDiagonalUp)
                        .LineStyle = True
                        .Weight = xlMedium
                        .Color = vbRed
                    End With
                End If
         Case 12
         myRng.Value = "OK"
          Application.EnableEvents = False
         Range("T15").Select
          Application.EnableEvents = True
        End Select
    End If

    Set myRng = Intersect(Target, Me.Range("C9:C28,D9:D28,E9:E28,F9:F8,G9:G28,H9:H28,I9:I28,J9:J28,K9:K28,L9:L28"))

 End Sub

色は付くには付くのですが

 If myRng.Column = 4 Or myRng.Column = 8 Or myRng.Column = 10 Then
                Application.EnableEvents = False
                  Set myRng = myRng.Offset(, 2)
                   myRng.Select
の箇所を実行しようとすると
myRng.Offset(, 2)は選択状態になるのですが、背景色は変わりません。その代わり
その手前の列の背景色が変わっています。
コードの入れる場所が違ってると思うのですがどこに入れるのでしょうか？
 Application.EnableEvents = False
 Application.EnableEvents = True
なども入れたのですがだめっだたのでお恥ずかしながら質問させてもらいました。
アドバイスお願いします。
（むむむ） 2022/04/23(土) 14:58

おそらく
オフセット2する時だけ、背景色を変えるイベントを無効にして
オフセット2して、セルを洗濯したら背景色を変えるイベントを有効にすると思うのですが
どこに入れたらいいかわかりません。
そもそも背景色を変えるコードの場所は先頭でいいのかも怪しいです。
標準モジュールに背景色を変えるコードを書いて
あとは各イベント毎に呼び出す方法とかもありですかね。
どなたか知恵を貸して下さい。
（むむむ） 2022/04/23(土) 20:01

もう少し考えてみます。
頭の中ではわかっているんですけど、
いざそれを実行に移すのは難しいですね。
（むむむ） 2022/04/24(日) 14:49

 前回も言っていますが表のレイアウト等を変更したのなら都度、詳しく説明してもらわないと･･･
 これで最後です。
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static myRng As Range, objText As Object, myColor As Long

    If Target.Count > 1 Or Target.Address = "$P$1" Then Exit Sub
    myColor = IIf(Range("P1").Value = 1, 4, 0)
    On Error GoTo ErrorHandler
    If Not myRng Is Nothing And GetAsyncKeyState(vbKeyReturn) And &H8000 Then
        Select Case myRng.Column
            Case 3, 6, 7
                myRng.Value = "OK"
            Case 4, 5, 8, 9, 10, 11
                Set objText = ActiveSheet.Shapes.AddTextbox(1, 0, 0, myRng.Height, myRng.Height)
                With objText
                    .Fill.Visible = msoFalse
                    .Line.Visible = msoFalse
                    .TextFrame.Characters.Text = ChrW(&H2714)
                    .TextFrame.Characters.Font.Color = vbRed '色
                    .TextFrame.Characters.Font.Size = 18  'サイズ
                  ' .TextFrame.AutoSize = msoAutoSizeShapeToFitText
                    .TextFrame.HorizontalAlignment = xlHAlignCenter
                    .TextFrame.VerticalAlignment = xlVAlignCenter
                    .Left = myRng.Left + (myRng.Width - .Width) / 2
                    .Top = myRng.Top + (myRng.Height - .Height) / 2
                End With
                If myRng.Column = 4 Or myRng.Column = 8 Or myRng.Column = 10 Then
                    Application.EnableEvents = False
                    myRng.Interior.ColorIndex = 0
                    Set myRng = myRng.Offset(, 2)
                    myRng.Select
                    myRng.Interior.ColorIndex = myColor
                    Application.EnableEvents = True
                    Exit Sub
                ElseIf myRng.Column = 5 Then
                    With Union(myRng.Cells(1, 2), myRng.Cells(1, 3), _
                            myRng.Cells(1, 4), myRng.Cells(1, 5)).Borders(xlDiagonalUp)
                        .LineStyle = True
                        .Weight = xlMedium
                        .Color = vbRed
                    End With
                    Application.EnableEvents = False
                    myRng.Interior.ColorIndex = 0
                    Set myRng = myRng.Offset(, 5)
                    myRng.Select
                    myRng.Interior.ColorIndex = myColor
                    Application.EnableEvents = True
                    Exit Sub
                ElseIf myRng.Column = 11 Then 'K列
                    With myRng.Offset(, 1).Borders(xlDiagonalUp)
                        .LineStyle = True
                        .Weight = xlMedium
                        .Color = vbRed
                    End With
                End If
            Case 12
                myRng.Value = "OK"
                Application.EnableEvents = False
                myRng.Interior.ColorIndex = 0
                Range("T15").Select
                Set myRng = Nothing
                Application.EnableEvents = True
                Exit Sub
        End Select
    End If
    If Not myRng Is Nothing Then myRng.Interior.ColorIndex = 0
    Set myRng = Intersect(Target, Me.Range("C9:L28"))
    If Not myRng Is Nothing Then myRng.Interior.ColorIndex = myColor
 Exit Sub
 ErrorHandler:
    MsgBox "Error Number = " & Err.Number & Chr(13) & _
           "Error Message = " & Err.Description, , "Debug"
 End Sub

（ピンク） 2022/04/24(日) 15:19

 >okのセルをダブルクリックしたらなぜかngのセルにレ点が入りました。 
 OKの上に赤☑が付きましたよ。
 標準モジュールに貼り付けて実行しましたか。
 ダブルクリックは必要ないです。
（パー） 2022/04/24(日) 20:29

パーさん。
ご返事ありがとうございます。
できましたか？
ちなみ、もし宜しかったらその時のコードを掲示してもらえませんか？
私もやってみようと思います。
（むむむ） 2022/04/24(日) 21:10

ピンクさん。
変更点お知らせせずまた大変失礼しまさした。
ただいまやってみた所無事に出来ました。
何度も質問してすみませんでした。
今回はイベント等の無効などの事が大変勉強になりました。
重ね重ね御礼申し上げます。
では失礼します。
（むむむ） 2022/04/24(日) 21:16

 >ちなみ、もし宜しかったらその時のコードを掲示してもらえませんか？ 
 何阿保なこと言ってんだよー。
 白茶さんのコードでうまくいかなかったんだろう。
 それを検証したまでだよ。
（パー） 2022/04/24(日) 21:43

Application.EnableEvents = True を書き忘れていました。

 Exit Sub
 ErrorHandler:
    MsgBox "Error Number = " & Err.Number & Chr(13) & _
           "Error Message = " & Err.Description, , "Debug"
    Application.EnableEvents = True
 End Sub

Application.EnableEvents = False
この後にエラーが発生するとイベント発生が
停止されたまま終わる為の対策です。

（ピンク） 2022/04/24(日) 21:58

コメント返信：

[ 一覧(最新更新順) ]

[[20220413130104]] 『文字の上にレ点を入れたい』（むむむ） ページの最後に飛ぶ

[[20220413130104]]　『文字の上にレ点を入れたい』（むむむ）　ページの最後に飛ぶ