エクセル ミニツールバーのフォント表示

質問

エクセル2010です。マクロなどはわかりません、すみません。

セル内の一文字だけ、フォントを変える
（たとえば、「りんご」だったら「ご」だけ、とか「ひまわり」だったら「ま」だけとか）
という作業をせねばなりません。

セルの中で一文字選択→右クリック→ミニツールバーのフォント表示で選ぶ

という手順でやっていますが、
ミニツールバーのフォント表示がずらずら出てきて選ぶのに手間取ります。
テーマのフォントに設定はしているのですが、
テーマのフォントが上の方に表示されるので、毎回スクロールしなければなりません。

ミニツールバーのフォント表示を、スクロールしないで済むようにすることはできないのでしょうか。
リボンのところであれば、いちおう上下矢印がでてきて、縮めることはできるのですが
毎回開く度にやはりずらずら出てきて面倒です。

わかりにくい説明で恐縮ですが、わかる方いらしたら教えてください。

まったく他のことでも、「セル内の一文字だけ、フォントを変える」（ただし、文字位置はランダム）ことが
簡単にできる方法があれば、それもありがたいです。よろしくお願い致します。

回答No.3

tom04

こんにちは！
セル内の文字を一文字ずつフォント変更するとなれば、マクロが手っ取り早いでしょうね！

そこでお望みの方法ではないと思いますが、やってみました。
↓の画像のようにSheet2のA列にフォント変更したいデータを表示しておきます。
そして、元データはSheet1のA1セル以降にあるとします。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub フォント変更() 'この行から
Dim i As Long, k As Long, str As String, c As Range, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
For i = 1 To wS1.Cells(Rows.Count, 1).End(xlUp).Row
For k = 1 To Len(wS1.Cells(i, 1))
str = Mid(wS1.Cells(i, 1), k, 1)
Set c = wS2.Range("A:A").Find(what:=str, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
With wS1.Cells(i, 1).Characters(Start:=k, Length:=1).Font
.Name = c.Font.Name
.Size = c.Font.Size '←サイズ変更がない場合は不要
.Color = c.Font.Color '←色変更がない場合は不要
End With
End If
Next k
Next i
Application.ScreenUpdating = True
End Sub 'この行まで

※　あくまで参考程度で・・・m（_ _）m

回答No.2

mitarashi

おもしろそうなので作ってみましたが、「マクロなどはわかりません」という事であれば、他の回答をお待ち下さい。
目的の文字の入ったセルでWクリックすると、ユーザーフォームが表示され、その中のテキストボックスでフォントを変更したい文字を選択（複数でも可）して、実行ボタンをクリックすると、目的の文字だけコード中で定数で指定したフォントに変わります。
編集中のセル内容の制御はVBAでは出来ないと思うので苦肉の策ですが、もっと良い案がありましたら、知りたいです。
☆目的のシートのシートモジュール
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
UserForm1.Show
End Sub

☆UserForm1モジュール（テキストボックス一個と、コマンドボタン一個を置く）
Const myFontName As String = "HGP創英角ゴシックUB"

Private Sub UserForm_Initialize()
Dim vframe As Double, hframe As Double
Const ctrlHeight As Double = 20
Const myFontSize As Double = 12

vframe = Me.Height - Me.InsideHeight
hframe = Me.Width - Me.InsideWidth
Me.Height = ctrlHeight + vframe
Me.Width = 140 + hframe
With Me.TextBox1
.Top = 0
.Left = 0
.Height = Me.InsideHeight
.Width = 100
.Font.Size = myFontSize
.Value = ActiveCell.Value
End With
With Me.CommandButton1
.Left = 100
.Top = 0
.Width = 40
.Height = ctrlHeight
.Caption = "実行"
.Font.Name = myFontName
.Font.Size = myFontSize
End With
End Sub

Private Sub CommandButton1_Click()
Dim myRange As Range

Set myRange = ActiveCell
myRange.Characters(Me.TextBox1.SelStart + 1, Me.TextBox1.SelLength).Font.Name = myFontName
Unload Me
End Sub

回答No.1

mu2011

口を開けて待っているだけでは何ともなりませんよ。
マクロ（ＶＢＡ）なら簡単に実現できるが手続きは非常に難しいので学習が必須ですね。

因みに同様の質問はこのサイトで既出と思いますのでサイト内検索してみては如何でしょうか。