選択したセルの文字列を変更しようとすると文字の大きさが変わってしまう、複数選択でも動くようにしたい

Question

前提・実現したいこと

Microsoft360のエクセルを使っています。VBAで、画像のようなチェックボックスの文字を選択するとチェックがついたり消えたりするようにしたいです。2列1行が1単位で、左のチェックボックスがオンになると右が入力可能になります。

また範囲で選択してもその部分が変わるようにしたいです。

発生している問題・エラーメッセージ

チェックボックスの大きさが変わってしまうことがあります。
游ゴシックがSegoe UI Symbolにかわっているからのようですが、変わってしまう基準がわかりません。変わるときも変わらない時もあります。

範囲で選択すると「型が一致しません」というエラーが出ます。

該当のソースコード

Private Sub Worksheet_SelectionChange(ByVal Target As Range)　
  With Target
   If .Value = ChrW(9744) Then
      .Value = ChrW(9745)
      .Offset(0, 1).Font.ColorIndex = xlAutomatic
   ElseIf .Value = ChrW(9745) Then
    .Value = ChrW(9744)
     With .Offset(0, 1)
          .Value = ChrW(9744) + "ﾘﾊ"
          .Font.ThemeColor = xlThemeColorDark1
          .Font.TintAndShade = -0.249977111117893
     End With
   ElseIf .Value = ChrW(9744) + "ﾘﾊ" Then
    If .Offset(0, -1).Value = ChrW(9745) Then
       .Value = ChrW(9745) + "ﾘﾊ"
    End If
   ElseIf .Value = ChrW(9745) + "ﾘﾊ" Then
     .Value = ChrW(9744) + "ﾘﾊ"
    End If
  End With
End Sub

試したこと

フォントを指定すれば大丈夫だと思いますが、なぜこうなってしまうのか知りたいです。

範囲に関しては、Rangeオブジェクトを各々のセルとして取得できればループで処理できるかと思いましたが、そのようなものは見つけられませんでした。

Answer 1

Excelファイルに入力中のフォントが強制的に游ゴシックへ変わる

↑これじゃないですかね？
最新のバージョンにアップデートしたら、なおるかも？

コードの方はこんな感じでまとめてみてはいかがでしょうか。

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rngEventArea As Range: Set rngEventArea = Me.Range("C3:F10")
    Dim c As Range
    
    Set Target = Intersect(Target.Resize(, 1), rngEventArea)
    If Target Is Nothing Then Exit Sub
    
    For Each c In Target.Cells
        CheckOnOff c
    Next
    
    rngEventArea(0, 1).Select
End Sub

Private Sub CheckOnOff(ByRef c As Range)
    Dim cmyTrue As String: cmyTrue = ChrW(9745)
    Dim cmyFalse As String: cmyFalse = ChrW(9744)
    Dim cDefault As String: cDefault = ChrW(9744) & "ﾘﾊ"
    Dim s As String
    Dim flg As Boolean
    
    If c.Font.Color = rgbLightSlateGray Then Exit Sub
    s = c.Value
    flg = CBool(InStr(s, cmyFalse))
    If flg Then
        s = Replace(s, cmyFalse, cmyTrue)
    Else
        s = Replace(s, cmyTrue, cmyFalse)
    End If
    c.Value = s
    If CBool(c.Column Mod 2) Then
        With c.Offset(, 1)
            .Value = cDefault
            .Font.Color = IIf(flg, vbBlack, rgbLightSlateGray)
        End With
    End If
End Sub

Comments

[halmichi]

ありがとうございます。

[halmichi]

ありがとうございます。
知らないメソッドが多く、理解に時間がかかっていますが、大変勉強になります。
CheckOnOffで変数Sにｃの値を格納してから処理しているのは可読性をよくするためという理解でいいですか？
よろしくお願いいたします。

[mattuwan]

ちょっと違います。
昔初心者だったころ(今も初心者なんですが)、
「同じ事を二度書くな」と習った事を、
実践しているだけです。

効能としては、
今回の件ではあまり関係ないかもですが、
メンテナンス性の向上があります。
例えば、
c.valueを
c.offset(0,1).value
に変えたくなったときに、
書き直す箇所が1箇所になります。

あと、
今回の件では、セルを読む回数が1回少なくなります。セルへのアクセスは結構重いので、出来れば回数を最低限にしたいです。(書き込みに比べたらたいしたことないですが)数十回程度なら気にならないですが、何千何万と繰り返せばかなりの時間になります。
また、ピリオドの登場回数を減らすのも、高速化に寄与します。

今回の件の場合、文字列の変更の部分を関数化することでさらに可読性が向上するかもしれませんが、プロシージャを分けるとステップインで処理の流れが追いにくいと感じる方もいるようなので、今は分かりやすい方でやってください。

自作関数を作るのに抵抗がなくなれば、レベル1upかも。

[halmichi]

ありがとうございます。
高速化、メンテナンス性などは今まで意識していませんでしたが、これからは頭の隅に置いておこうと思います。

Answer 2

フォントか勝手に変わらないようにするには、対象セル範囲を選択した状態で、右クリック→セルの書式設定→フォント で「標準フォント」のチェックを外せば、指定したフォント固定になります。

フォントを指定すれば大丈夫だと思いますが、なぜこうなってしまうのか知りたいです。

フォントを設定すると「標準フォント」も自動ではずれます。
「標準フォント」は文字種（日本語とか記号とか）に応じて適するとEXCELくんが判断したフォントにするという仕様なのだと思います。

範囲に関しては、Rangeオブジェクトを各々のセルとして取得できればループで処理できるかと思いましたが、

下記のコードでどうでしょう。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rngCell As Range
    
    For Each rngCell In Target
        CheckChange rngCell
    Next
End Sub

Private Sub CheckChange(ByVal rngCell As Range)
  With rngCell
   If .Value = ChrW(9744) Then
      .Value = ChrW(9745)
      .Offset(0, 1).Font.ColorIndex = xlAutomatic
   ElseIf .Value = ChrW(9745) Then
    .Value = ChrW(9744)
     With .Offset(0, 1)
          .Value = ChrW(9744) + "ﾘﾊ"
          .Font.ThemeColor = xlThemeColorDark1
          .Font.TintAndShade = -0.249977111117893
     End With
   ElseIf .Value = ChrW(9744) + "ﾘﾊ" Then
    If .Offset(0, -1).Value = ChrW(9745) Then
       .Value = ChrW(9745) + "ﾘﾊ"
    End If
   ElseIf .Value = ChrW(9745) + "ﾘﾊ" Then
     .Value = ChrW(9744) + "ﾘﾊ"
    End If
  End With
End Sub

---

ちみなにこのWorksheet_SelectionChangeを使用する方法は、同じセルを繰り返しクリックても無反応なのが気になります。
間違えてチェックしてしまったとき、チェックを外すには、一度別セルをクリックしてからでないとチェックを外せません。
通常のチェックボックスはクリックするたびにチェックのオンオフが可能です。

フォームコントロールかActiveXコントロールのチェックボックスを配置する方法の方がいいように思います。

Comments

[halmichi]

ありがとうございます。レンジオブジェクトをFor Eachで処理すればよかったんですね。
勉強になりました。

ご指摘の通り、初めはチェックボックスを置こうと思っていたのですが、前の処理で「行列のヘッダを読み込んで自動生成したい」ものであったので、セルに入れられず断念した結果こうなっています。
このスクリプトは初めGASで作ったのですが、ネットが不安定だとうまく動作しないことがあってエクセルに移植しています。GASだとチェックボックスがセルに埋め込まれているので楽だったのですが。。

何かうまい手はあるでしょうか？というか、その質問は新たにしたほうがいいですか？
よろしくお願いいたします。

[hatena19]

おそらく結構なボリュームになると思いますので、新規に質問しなおした方かいいと思います。

[halmichi]

ありがとうございます。
そうします。