[[20210901175358]]　『太字設定について』（よん）　ページの最後に飛ぶ

『太字設定について』（よん）

こんにちは。

早速ですが、セル内の文章のうち一部分を選択して、『Ctrl＋B』で太字の設定をし、リボン上のフォントの色ボタンクリックで赤色を設定するという作業について相談です。

例：今日の天気は晴れです。　※「晴れ」だけ太字赤字にしたい。

この赤色を設定するという作業を手間に感じており、例えば『Ctrl＋B』を押すと太字＆赤色の設定がされる方法が無いかと考えています。

自分が調べた限りでは、標準機能では出来なさそうです。
VBAで何か出来ないかと試してみましたが、こちらも自分の知識ではセルが編集状態となっている時にマクロを実行することが出来ませんでした。（そもそも出来ないかな？）

何か良い知恵がないでしょうか？よろしくお願いします。

※余談？になりますが、依然こちらで質問させて頂き、回答を元に少し改良して下記のマクロにて太字を太字赤字に変換するマクロを使用しております。
ただ、割と高頻度でエクセルが強制終了するエラーが生じてしまうため（多分PCの性能上の問題かなと思います。）、マクロ開始時に一旦上書き保存するといったことで対処し、活用させて頂いておりますが、強制終了すると他のエクセルファイルも落ちてしまい不便なため、そもそも手動で太字設定する時点で赤字になればいいなと思い、上記質問をさせて頂きました。

https://www.excel.studio-kazu.jp/kw/20210616111834.html

Sub フォント設定()

    Dim chs As Characters
    Dim v() As Boolean
    Dim i As Long
    Dim j As Long
    Dim col As Long
    col = ActiveCell.Column

    ThisWorkbook.Save
    Application.ScreenUpdating = False

    For i = Selection.row To Selection.row + Selection.Rows.Count - 1
        If Cells(i, col) <> "" Then

            ReDim v(1 To Cells(i, col).Characters.Count)

            For j = LBound(v) To UBound(v)
                v(j) = Cells(i, col).Characters(j, 1).Font.Bold
            Next j

            For j = LBound(v) To UBound(v)
                If v(j) Then
                    With Cells(i, col).Characters(j, 1).Font
                        .Bold = True
                        .Color = vbRed
                    End With
                End If
            Next j
        End If
    Next i

    Application.ScreenUpdating = False

    MsgBox "終了"
End Sub

＜使用 Excel：Excel2011(Mac)、使用 OS：Windows8 ＞

 回答が付いてなかったので、こんなことで良いのでしょうか？

 前回のスレをまだよく見てないので...違ったらすいません。

 今日の天気は晴れです。

 を A1 から E10 までテストとして配置して、掲示されたコードに
 追記しました。

 Sub フォント設定()
    Dim chs As Characters
    Dim v() As Boolean
    Dim i As Long
    Dim j As Long
    Dim x As Long
    Dim y As Long
    Dim col As Long
    col = ActiveCell.Column
    ThisWorkbook.Save
    Application.ScreenUpdating = False

    For x = 1 To 10
        For y = 1 To 5
            With Cells(x, y).Characters(Start:=7, Length:=2).Font
            .Bold = True
            .ColorIndex = 3
            End With
        Next y
    Next x

   ... 略 ...

 End Sub

 2010で確認しました。

 で上記をさらに...どうしろって事が理解し難いです。

  ＞セルが編集状態となっている時にマクロを実行することが出来ませんでした。（そもそも出来ないかな？）

 これは、まだよくわからないです。^^;

 ＞『Ctrl＋B』を押すと太字＆赤色の設定がされる方法が無いかと考えています。

 これはなんでしょう？

 編集状態でマクロが走らせれないから、キー操作でなんとかしたいってことですか？

 編集終わってからではダメなのかしら？

 文章がサンプルは短いけど、実際は長～いから忘れちゃうからその都度したいって意味なのでしょうか？

（あみな） 2021/09/02(木) 14:28

 ※余談について

 ＞ただ、割と高頻度でエクセルが強制終了するエラーが生じてしまうため（多分PCの性能上の問題かなと思います。）

 処理量なのか、処理負荷なのか、エラーが出やすい操作なのかでしょうか？
 PCの性能上の問題ではないような気がしますけど。

 例 私の経験だけ^^;

 カウントダウンタイマー走らせながら下記の何をした時か忘れましたけど

 Ontime、setTime、TimeoutA、Wsh　入れて

 さらに Application.Goto 実行したら強制終了されました。(笑)

（あみな） 2021/09/02(木) 14:45

'シートモジュールに記載
Dim tcell As Range

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not tcell Is Nothing And Len(tcell.Value) > 0 Then 新フォント設定 tcell
Set tcell = Target
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not tcell Is Nothing And Len(tcell.Value) > 0 Then 新フォント設定 tcell
Set tcell = Target
End Sub

Sub 新フォント設定(arg)

    Dim j As Long
    If arg.Characters.Count = 0 Then Exit Sub
    ThisWorkbook.Save
    Application.ScreenUpdating = False
        For j = 1 To arg.Characters.Count
            If arg.Characters(j, 1).Font.Bold Then
            arg.Characters(j, 1).Font.Color = vbRed
            End If
        Next j
End Sub
（mm） 2021/09/02(木) 15:24

 >『Ctrl＋B』を押すと太字＆赤色の設定がされる方法が無いかと考えています。
 Ctrl + Shift + B
 1) ThisWorkbook モジュール
 'ショートカットキーの設定
 Private Sub Workbook_Open()
     Application.OnKey "^B", "test"
 End Sub
 'ショートカットキーの解除
 Private Sub Workbook_BeforeClose(Cancel As Boolean)
     Application.OnKey "^B"
 End Sub

 2) 標準モジュール
 Sub test()
     Dim r As Range, ff As String, x As Long
     Const myStr As String = "晴れ"
     Set r = Cells.Find(myStr, , , 2)
     If Not r Is Nothing Then
         ff = r.Address
         Do
             x = InStr(r, myStr)
             Do While x
                 With r.Characters(x, Len(myStr)).Font
                     .Color = vbRed
                     .Bold = True
                 End With
                 x = InStr(x + 1, r, myStr)
             Loop
             Set r = Cells.FindNext(r)
         Loop While ff <> r.Address
     End If
 End Sub
（seiya） 2021/09/02(木) 15:29

コメント返信：

[ 一覧(最新更新順) ]

[[20210901175358]] 『太字設定について』（よん） ページの最後に飛ぶ

[[20210901175358]]　『太字設定について』（よん）　ページの最後に飛ぶ