選択セルの値を使ってテキストボックスを作成するマクロを書いていて
![イメージ 1]()
テキストボックスを作りたいセルを選択してマクロを実行
![イメージ 2]()
セルの値が入ったテキストボックスが作成された
![イメージ 3]()
正解のフォントの指定の仕方は
![イメージ 4]()
![イメージ 5]()
フォントの指定が難しかったのでメモ
これが求めていた結果、ここまで難しかった
期待はずれな例
日本語の文字だけが指定したフォントにならずに
MS ゴシックになっていた
charaCount=Shape.TextFrame2.TextRange.Characters.Count'文字数カウント
Shape.TextFrame2.TextRange.Characters(1, charaCount).Font.Name = フォント名 '英数字用
Shape.TextFrame2.TextRange.Characters(1, charaCount).Font.NameFarEast = フォント名 '日本語用
TextFrame2のTextRangeのCharactersで文字列のどこからどこまでかを指定していして
ここでは全部の文字だから1番目の文字から文字数(最後の文字)を指定して
ここでやっとフォントの指定のFont.Nameでフォントを指定する
しかも
Font.Nameっていう半角英数字用と
Font.NameFarEastっていう日本語用
この2つに指定しなければならない
Excel 2007 のテキスト ボックスで使用するフォントの種類をマクロで変更できない
マイクロソフトのここを見ると現在調査中ってあるけど
2007年11月から何年調査しているんだろうって、エクセル2007のバグか仕様みたい
回避策としてFont.NameFarEastっていう日本語用だけを指定すればいいように書いてあるけど、フォントによっては両方共指定しないとおかしくなる
紛らわしかったのがテキストボックスや図形のフォントの指定ができそうなところがあちこちにあること
Shape.TextEffect.FontName
Shape.TextFrame.Characters.Font.Name
Shape.TextFrame.Characters(1,n).Font.Name
Shape.TextFrame2.Characters.Font.Name
Shape.TextFrame2.Characters(1,n).Font.Name
TextBox.Font.Name
これ全部できそうに見えてできないもので
正解は
Shape.TextFrame2.Characters(1,n).Font.Name
Shape.TextFrame2.Characters(1,n).Font.NameFarEast
この2つ、両方必要
あとエクセル2007は図形関係のマクロの記録ができない！
なので手動で変更してどんな動きしているのか見ることもできず
そんなこんなで時間がかかった
セルのフォント指定は
Range.Font.Name
でできるんだからテキストボックスとかの図形も
Shape.Font.Name
これでできればわかりやすいのになあ
せめてShape.TextFrame.Font.Nameとか
選択セルの値でテキストボックスを作成するマクロ
Sub SelectionValueTextBox選択セルの値でテキストボックスを作成する()
On Error Resume Next
Dim r As Range
Dim s As Shape
Dim sh As Worksheet: Set sh = ActiveSheet
Dim charaCount As Long
For Each r In Selection
'テキストボックス作成
Set s = sh.Shapes.AddTextbox( _
msoTextOrientationHorizontal, r.Width + r.Left, r.Top, r.Width, r.Height)
s.TextEffect.Text = r.Value 'セルの値をテキストボックスの文字に指定
With s.TextFrame
.HorizontalAlignment = xlHAlignCenter '水平中央
.VerticalAlignment = xlVAlignCenter '垂直中央
.AutoSize = True 'テキストに合わせてサイズを自動変更
End With
charaCount = s.TextFrame2.TextRange.Characters.Count '文字数カウント
With s.TextFrame2.TextRange.Characters(1, charaCount).Font 'フォント設定
.Name = r.Font.Name '英数字
.NameFarEast = r.Font.Name '日本語
.Size = r.Font.Size 'サイズ
End With
'背景色ランダム、文字色白
' Randomize
' s.Fill.ForeColor.RGB = Int((16777215 - 0 + 1) * Rnd(16777215) - 0)
' s.TextFrame.Characters.Font.Color = RGB(255, 255, 255)
Next
End Sub
背景色ランダム、文字色白
今回大活躍の
アクティブシートの図形全部を削除するマクロSub ShapesAllDelete全図形削除()
ActiveSheet.Shapes.SelectAll
Selection.Delete
End Sub
これはここを参照した
図形を一括削除するExcelマクロ:エクセルマクロ・Excel VBAの使い方-マクロのサンプル