vba textboxの文字のサイズの変更

質問

excel vbaで作成したtextboxの中の文字を大きくしたいのですが、うまくいきません、どなたか教えていただけませんか。
今回の場合はtextboxは、透明ですので必要はありませんが、できましたら、文字の色、背景の色、枠組の線、文字の位置の変更、等についてのコードなど併せ教えていただけましたらうれしいです。
コードは以下の様になっています、（質問箱で教えて頂いたものを若干修正したもにです。）
------------------------------------------------------------------------------
dim temp as shape
dim j , m , k , t as long
with sheets("ツーリングダイヤ")
t = .range("c110").value
for j = 104 to t step1’駅数の数NEXT
m = .range("e99").value’表示位置調整
k = .cells(j,+m,3).value’表示位置取得
set temp = worksheets("ツーリングダイヤ").shapes.addtextbox_(msotextorientstionhorizontal,65,k,65,17) ’駅名表示用BOX
temp.textframe.characters.text = worksheets("ツーリングダイヤ").cells(j,2).value’駅名転記
with temp
.line.visible = falue’透明
.fill.visible = falue
end with
next j
end with
---------------------------------------
上記コードにどのようなコードを追加したらいいでしょうか、教えて頂けませんか。

回答No.6

kagakusuki · ベストアンサー

回答No.5で書き切れなかったVBAマクロの構文の続きです。

'表示位置調整用データの取得及び確認
m = .Range(AdjustCell).Value '表示位置調整用データ
If Not IsNumeric(m) Then GoTo label2
If m <> Int(m) Then GoTo label2
Set StName = .Range(NameCell).Resize(t, 1)
myOffsetC = .Columns(PositColumn).Column - StName.Column
'↑表示位置が入力されているセルと駅名が入力されているセルとの列の差

'Textboxの作成位置として無効なものが存在するかどうかを確認し、もし存在すればピックアップして表示
NoDataStation = ""
For Each c In StName '駅数の数NEXT
If c.Value = "" Then GoTo label3
k = c.Offset(m, myOffsetC).Value '表示位置取得
If k <> "" And IsNumeric(k) And k >= 0 Then GoTo label3
NoDataStation = NoDataStation & Chr(13) & Left(c.Value & String(19, "　"), 19) _
& c.Offset(m, myOffsetC).Address(RowAbsolute:=False, ColumnAbsolute:=False) & " = """ & k & """"
label3:
Next c
If NoDataStation <> "" Then
myMsg = MsgBox("以下の駅には位置情報として有効なデータが存在しません。" & Chr(13) & Chr(13) & _
NoDataStation & Chr(13) & Chr(13) & _
"Textboxの作成の際にはこれらの駅は無視して" & Chr(13) & "他の駅のTextboxのみを作成しますか？" _
& Chr(13) & Chr(13) & "[はい] : 有効な位置データが存在する駅のみTextboxを作成します" & Chr(13) _
& "[いいえ] : マクロを終了します", vbExclamation + vbYesNo + vbDefaultButton2, "無効なデータ")
If myMsg <> vbYes Then
MsgBox "マクロを終了します。", vbInformation, "マクロの終了"
Exit Sub
End If
End If

'Textboxの作成及び属性調整
For Each c In StName '駅数の数NEXT
If c.Value = "" Then GoTo label4
k = c.Offset(m, myOffsetC).Value '表示位置取得
If Not IsNumeric(k) Then GoTo label4
If k < 0 Or k = "" Then GoTo label4
Set temp = Sheets(mySheet).Shapes.AddTextbox(msoTextOrientationHorizontal, 65, k, 0, 0) 'テキストボックス作成
With temp
With .TextFrame

'テキストを図形からはみ出して表示する
.HorizontalOverflow = 0
.VerticalOverflow = 0

.Characters.Text = c.Value '図形内のテキストに駅名を入力
End With
With .TextFrame2
With .TextRange
.ParagraphFormat.Alignment = msoAlignCenter '図形内のテキストの水平方向の配置=中央揃え
With .Font
.Size = 10.5 '図形内のテキストのフォントサイズを10.5ptに設定
.NameFarEast = "ＭＳ Ｐゴシック" '図形内のテキストのフォントを"ＭＳ Ｐゴシック"にする
.Fill.ForeColor.RGB = RGB(255, 0, 0) '文字色を赤に設定
'※黒:RGB( 0, 0, 0)、白:RGB( 255, 255, 255)、緑:RGB( 0, 255, 0)、青:RGB( 0, 0, 255)、
'黄:RGB( 255, 255, 0)、紫:RGB( 255, 0, 255)、橙:RGB( 0, 255, 255)
.NameFarEast = "ＭＳ Ｐゴシック" '図形内のテキストのフォントを"ＭＳ Ｐゴシック"にする
End With
End With
.VerticalAnchor = msoAnchorMiddle '図形内のテキストの垂直方向の配置=上下中央

'テキストに合わせて図形のサイズを調整する(必ず折り返し無しと共に使用)
.WordWrap = False '図形内でテキストを折り返さない
.AutoSize = 1 'テキストに合わせて図形のサイズを調整する

End With
.Line.Visible = False '線なし
.Fill.Visible = False '塗りつぶしなし
End With
label4:
Next c
End With
GoTo labelE

label1: '駅の数のデータが無効なデータであった場合
MsgBox mySheet & "!" & NumStCell & "セルに入力されている値" _
& Chr(13) & Chr(13) & t & Chr(13) & Chr(13) _
& "では駅の数として使う事が出来ません。" & Chr(13) _
& "マクロを終了します。", vbExclamation, "無効な値"
GoTo labelE

label2: 'テキストボックスの表示位置調整のデータが無効なデータであった場合
MsgBox mySheet & "!" & AdjustCell & "セルに入力されている値" _
& Chr(13) & Chr(13) & m & Chr(13) & Chr(13) _
& "ではテキストボックスの表示位置調整の値として使う事が出来ません。" _
& Chr(13) & "マクロを終了します。", vbExclamation, "無効な値"
GoTo labelE

labelE:

End Sub

　以上です。

お礼

ありがとう御座います。
今,受信を確認しました。こんなにも詳しく教えて頂きほんとにありがとうございます。
ご迷惑おかけしました。早速勉強したいと思います。

改めて、本当に、本当にありがとうございました。感謝いたします。
今後ともよろしくお願いいたします。

回答No.5

kagakusuki

>早速次のように、コードを追加してみましたが解決できませんでした。

との事ですので、取り敢えず、セルに入力する事で設定されるデータや、一部のVBAの構文内で指定されているデータに不適当なものや、欠落があった場合には、主に間違いが発生しやすいのではないかと思える箇所に関しては、何処が誤っているのかを表示する様にしたVBAを組んでみました。
　処で、質問者様のVBAでは

k = .Cells(j + m, 3).Value '表示位置取得

の所で表示位置が入力されているセルはj + m行目に存在しているとなっているのに対し、

temp.TextFrame.Characters.text = Worksheets("ツーリングダイヤ").Cells(j, 2).Value 'BOXに駅名転記

の所で、駅名が入力されているセルはj行目にあるセルという事になっておりますが、駅名が入力されている行と表示位置のデータが入力されている行が異なる行となっているなどという、入力し難い作りとなっているのは何故なのでしょうか？
　その理由がどの様なものなのか解りませんでしたので、「表示位置のデータが入力されている行」は「駅名が入力されている行」のm行下の行であるとする条件は、今回私が組んだVBAにおいてもそのまま残しております。
　後、質問者様のVBAでは

t = .Range("c110").Value

において、C110セルに入力する値を駅の数ではなく、「駅名を入力するセルの中で最も下となるセルの行番号」にしなければならなくなっておりますが、今回私が組んだVBAを使用する際には「駅の数」を入力する様にして下さい。

　尚、

>textboxの中の文字を大きくしたい

というだけではどこまで大きくすれば良いのか解りませんでしたので、取り敢えず文字サイズを10.5ptに設定する様にしておきましたから、別のサイズにされる際には

.Size = 10.5 '図形内のテキストのフォントサイズを10.5ptに設定

という箇所の10.5の部分を他の数値に変更して下さい。
　その際の有効な値は正の数(小数点以下の桁数を含んだ数も可)です。

　又、

>今回の場合はtextboxは、透明ですので必要はありませんが、できましたら、文字の色、背景の色、枠組の線、文字の位置の変更、等についてのコードなど併せ教えていただけましたらうれしいです。

との事でしたので、参考となる様に(テキストボックスは透明にしたままで)文字の色を赤、フォントの種類をＭＳ Ｐゴシックとなる様にしておりますので、不要な様でしたら該当箇所を削除して下さい。
　後、図形の位置は、通常のやり方では図形を囲む事が出来る最小の大きさを持つ長方形の左上の隅の頂点の位置で指定するものなのですが、透明なテキストボックスを使用しているというのに、その見えないボックスの左上の隅を基準にしてもあまり意味はない様にも思えましたし、折角縦一列に並べて配置しているというのに、駅名を表す文字列の右端の位置が、駅名の長さによってバラバラとなってしまっては見栄えが良くないようにも思えましたので、文字列の中心部分の位置で配置する位置を指定する様にしております。
　その方法としては、まず縦横のサイズが0のボックスを作成する事で、左上の隅の頂点位置と、ボックスの中心の位置が一致する様にし、続いて文字列の折り返し無しモードとしてから、文字の上下の配置と、左右の配置を共に中央揃えとする事で、文字列の中心位置と、ボックスが配置されている位置が一致する様にしております。
　只、サイズが0のテキストボックスでは、後からそのボックスを選択しようとした際に、選択する事が困難となりますので、文字列の中心位置とボックスの中心位置を一致させた後で、ボックスのサイズを文字列を囲む様なサイズに変更しています。
　その際、透明なテキストボックスという事ですので、ボックスのサイズは一定とせずに、文字列の長さとフォントサイズに合わせて変わる様にしております。

Sub QNo8957421_vba_textboxの文字のサイズの変更_改()

Dim temp As Shape
Dim j, k, myOffsetC As Long
Dim mySheet, NumStCell, AdjustCell, NameCell, PositColumn, NoAddress, BlankCell, InvalidCell, NoDataStation As String
Dim m, t As Variant
Dim c, StName As Range
Dim IgnoreBlank, IgnoreInvalid As Boolean
Dim myMsg As Byte

mySheet = "ツーリングダイヤ" '処理の対象とするシートのシート名
NumStCell = "C110" '駅数が入力されているセルのセル番号
'※上記のセルには「駅名等が入力されている最後のセルの行番号」ではなく、
'駅の数を入力して下さい。
AdjustCell = "E99" '表示位置調整のデータが入力されているセルのセル番号
NameCell = "B104" '駅名が入力されている最初のセルのセル番号
PositColumn = "C" '表示位置のデータが入力されているセルが存在する列

'シートの有無を確認
If IsError(Evaluate("ROW('" & mySheet & "'!A1)")) Then
MsgBox """" & mySheet & """シートが見つかりません。" _
& Chr(13) & "マクロを終了します。", vbExclamation, "存在しないシート"
GoTo labelE
End If

If IsError(Evaluate("ROW('" & mySheet & "'!" & NumStCell & ")")) Then _
NoAddress = NoAddress & "NumStCell = """ & NumStCell & """" & Chr(13) & Chr(13) '駅数が入力されているセルのセル番号の有無確認
If IsError(Evaluate("ROW('" & mySheet & "'!" & AdjustCell & ")")) Then _
NoAddress = NoAddress & "AdjustCell = """ & AdjustCell & """" & Chr(13) & Chr(13) '表示位置調整のデータが入力されているセルのセル番号の有無確認
If IsError(Evaluate("ROW('" & mySheet & "'!" & NameCell & ")")) Then _
NoAddress = NoAddress & "NameCell = """ & NameCell & """" & Chr(13) & Chr(13) '駅名が入力されている最初のセルのセル番号の有無確認
If IsError(Evaluate("ROW('" & mySheet & "'!" & PositColumn & 1 & ")")) Then _
NoAddress = NoAddress & "PositColumn = """ & PositColumn & """" & Chr(13) & Chr(13) '表示位置のデータが入力されているセルが存在する列番号の有無確認

'マクロのVBA構文内で使用されているセル番号や列番号に誤りがある場合には、その旨を表示した後、マクロを終了
If NoAddress <> "" Then
NoAddress = NoAddress & "においてセル番号として規定されている値は、セル番号"
If InStr(NoAddress, "PositColumn = ") > 0 Then _
NoAddress = Replace(NoAddress, "セル番号", "セル番号や列番号")
MsgBox "本マクロのVBAの構文中の以下の部分" & Chr(13) & Chr(13) & NoAddress & _
"として使用出来ない値であるため、このままではマクロを実行出来ません。" & Chr(13) & _
"マクロを実行を中止致しますので、上記の部分におけるアドレス番号を正しいものに修正して下さい。" _
, vbExclamation, "無効なアドレス番号"
GoTo labelE
End If

'駅数のデータの取得及び確認
With Sheets(mySheet)
t = .Range(NumStCell).Value '駅数
If Not IsNumeric(t) Then GoTo label1
If t <> Int(t) Or t < 1 Then GoTo label1

※まだ途中なのですが、回答欄に入力可能な文字数を超えてしまいますので、残りは又後で投稿させて頂きます。

回答No.4

kagakusuki

【Shape変数を使って規定される図形の設定を行う場合のコード】の続きです。

myShape.TextFrame2.Orientation = msoTextOrientationHorizontalRotatedFarEast '縦書き(半角文字含む)
myShape.TextFrame2.Orientation = msoTextOrientationHorizontal '横書き

'テキストに合わせて図形のサイズを調整する
With myShape.TextFrame2
.WordWrap = False
.AutoSize = 1
End With

myShape.Visible = False '図形非表示
myShape.Visible = True '図形非表示の解除(選択あるいは指定が可能であればの話)
myShape.Fill.Visible = True '塗りつぶしあり
myShape.Fill.Visible = False '塗りつぶしなし
myShape.Fill.ForeColor.RGB = RGB(255, 0, 0) '塗りつぶし色を赤に設定
'※黒:RGB( 0, 0, 0)、白:RGB( 255, 255, 255)、緑:RGB( 0, 255, 0)、青:RGB( 0, 0, 255)、黄:RGB( 255, 255, 0)、紫:RGB( 255, 0, 255)、橙:RGB( 0, 255, 255)

myShape.TextFrame2.AutoSize = False 'テキストに合わせて図形のサイズを調整しない
myShape.TextFrame2.WordWrap = True '図形内でテキストを折り返す
myShape.TextFrame2.WordWrap = False '図形内でテキストを折り返さない
myShape.TextFrame2.MarginLeft = 12.345 '図形内のテキストの左の余白を12.345ptに設定
myShape.TextFrame2.MarginRight = 12.345 '図形内のテキストの右の余白を12.345ptに設定
myShape.TextFrame2.MarginTop = 12.345 '図形内のテキストの上の余白を12.345ptに設定
myShape.TextFrame2.MarginBottom = 12.345 '図形内のテキストの下の余白を12.345ptに設定

'テキストを図形からはみ出して表示する
With myShape.TextFrame
.HorizontalOverflow = 0
.VerticalOverflow = 0
End With

'テキストを図形からはみ出して表示しない
With myShape.TextFrame
.HorizontalOverflow = 1
.VerticalOverflow = 1
End With

myShape.Height = 12.345 '図形の高さを12.345ptに設定
myShape.Width = 12.345 '図形の横幅を12.345ptに設定
myShape.LockAspectRatio = True '図形の縦横比を固定
myShape.LockAspectRatio = False '図形の縦横比を固定しない
myShape.Rotation = 120 '図形を右回りに120度回転
myShape.Rotation = -750 '図形を左回りに750度回転

myShape.Line.Visible = True '線あり
myShape.Line.Visible = False '線なし
myShape.Line.Weight = 12.345 '線の太さを12.345ptに設定
myShape.Line.ForeColor.RGB = RGB(255, 0, 0) '線の色を赤に設定

myShape.Line.Style = msoLineSingle '一重線
myShape.Line.Style = msoLineThinThin '二重線
myShape.Line.Style = msoLineThickThin '太線+細線
myShape.Line.Style = msoLineThinThick '細線+太線
myShape.Line.Style = msoLineThickBetweenThin '三重線

myShape.Line.DashStyle = msoLineSolid '実線
myShape.Line.DashStyle = msoLineSysDot '点線(丸)
myShape.Line.DashStyle = msoLineSysDash '点線(角)
myShape.Line.DashStyle = msoLineDash '破線
myShape.Line.DashStyle = msoLineDashDot '一点鎖線
myShape.Line.DashStyle = msoLineLongDash '長破線
myShape.Line.DashStyle = msoLineLongDashDot '長鎖線
myShape.Line.DashStyle = msoLineLongDashDotDot '長二点鎖線

　図形の設定をVBAを使って行う場合のコードには、まだ他にも様々なものが御座いますが、私が調べたものは以上になります。

回答No.3

kagakusuki

【選択済みの図形の設定を行う場合のコード】の続きです。

Selection.Height = 12.345 '図形の高さを12.345ptに設定
Selection.Width = 12.345 '図形の横幅を12.345ptに設定
Selection.ShapeRange.LockAspectRatio = True '図形の縦横比を固定
Selection.ShapeRange.LockAspectRatio = False '図形の縦横比を固定しない
Selection.ShapeRange.Rotation = 120 '図形を右回りに120度回転
Selection.ShapeRange.Rotation = -750 '図形を左回りに750度回転

Selection.ShapeRange.Line.Visible = True '線あり
Selection.ShapeRange.Line.Visible = False '線なし
Selection.ShapeRange.Line.Weight = 12.345 '線の太さを12.345ptに設定
Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0) '線の色を赤に設定

Selection.ShapeRange.Line.Style = msoLineSingle '一重線
Selection.ShapeRange.Line.Style = msoLineThinThin '二重線
Selection.ShapeRange.Line.Style = msoLineThickThin '太線+細線
Selection.ShapeRange.Line.Style = msoLineThinThick '細線+太線
Selection.ShapeRange.Line.Style = msoLineThickBetweenThin '三重線

Selection.ShapeRange.Line.DashStyle = msoLineSolid '実線
Selection.ShapeRange.Line.DashStyle = msoLineSysDot '点線(丸)
Selection.ShapeRange.Line.DashStyle = msoLineSysDash '点線(角)
Selection.ShapeRange.Line.DashStyle = msoLineDash '破線
Selection.ShapeRange.Line.DashStyle = msoLineDashDot '一点鎖線
Selection.ShapeRange.Line.DashStyle = msoLineLongDash '長破線
Selection.ShapeRange.Line.DashStyle = msoLineLongDashDot '長鎖線
Selection.ShapeRange.Line.DashStyle = msoLineLongDashDotDot '長二点鎖線

【選択済みの図形の設定を行う場合のコード】は以上ですが、Shape変数を使ってShapeオブジェクトを指定し、その指定されているShapeオブジェクトの設定を変更する場合には、Selectionで選択&指定したShapeオブジェクトの設定を変更するのとは、コードが若干異なるものが一部にはある様ですので、Shape変数を使って指定されているShapeオブジェクトの設定を変更するコードに関してもここでまとめて紹介しておこうと思います。
　尚、以下はmyShapeという名称のShape変数を用いた場合の例です。

【Shape変数を使って規定される図形の設定を行う場合のコード】

Dim myShape As Shape

'(左端より10pt、上端より20ptの位置に、横幅30pt、高さ40ptの横書きの)テキストボックスを作成
Set myShape = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 20, 30, 40)
'書式 AddTextbox(Orientation, Left, Top, Width, Height)
'Orientation:文字列の向き。(横書き:msoTextOrientationHorizontal、縦書き:msoTextOrientationVertical)
'位置の座標はA1セルの左上隅を基点として、図形を囲む事が出来る最少の長方形の左上の頂点の座標

myShape.TextFrame.Characters.Text = "テキスト入力"　'図形内のテキストを"テキスト入力"にする

'図形内のテキストの垂直方向の配置=上
With myShape.TextFrame2
.VerticalAnchor = msoAnchorTop
.HorizontalAnchor = msoAnchorNone
End With

'図形内のテキストの垂直方向の配置=上下中央
With myShape.TextFrame2
.VerticalAnchor = msoAnchorMiddle
.HorizontalAnchor = msoAnchorNone
End With

'図形内のテキストの垂直方向の配置=下
With myShape.TextFrame2
.VerticalAnchor = msoAnchorBottom
.HorizontalAnchor = msoAnchorNone
End With

'図形内のテキストの垂直方向の配置=上中央
With myShape.TextFrame2
.VerticalAnchor = msoAnchorTop
.HorizontalAnchor = msoAnchorCenter
End With

'図形内のテキストの垂直方向の配置=中心
With myShape.TextFrame2
.VerticalAnchor = msoAnchorMiddle
.HorizontalAnchor = msoAnchorCenter
End With

'図形内のテキストの垂直方向の配置=下中央
With myShape.TextFrame2
.VerticalAnchor = msoAnchorBottom
.HorizontalAnchor = msoAnchorCenter
End With

'図形内のテキストの水平方向の配置=左揃え
With myShape.TextFrame2
.HorizontalAnchor = msoAnchorNone
.TextRange.ParagraphFormat.Alignment = msoAlignLeft
End With

'図形内のテキストの水平方向の配置=中央揃え
myShape.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter

'図形内のテキストの水平方向の配置=右揃え
With myShape.TextFrame2
.HorizontalAnchor = msoAnchorNone
.TextRange.ParagraphFormat.Alignment = msoAlignRight
End With

myShape.TextFrame2.TextRange.Font.Size = 10.5 '図形内のテキストのフォントサイズを10.5ptに設定
myShape.TextFrame2.TextRange.Font.Bold = True '図形内のテキスト太字
myShape.TextFrame2.TextRange.Font.Bold = False '図形内のテキスト太字解除
myShape.TextFrame2.TextRange.Font.Italic = True '図形内のテキスト斜体
myShape.TextFrame2.TextRange.Font.Italic = False '図形内のテキスト斜体解除
myShape.TextFrame2.TextRange.Font.NameFarEast = "ＭＳ Ｐゴシック" '図形内のテキストのフォントを"ＭＳ Ｐゴシック"にする
myShape.TextFrame2.TextRange.Font.NameFarEast = "ＭＳ Ｐ明朝" '図形内のテキストのフォントを"ＭＳ Ｐ明朝"にする
myShape.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0) '文字色を赤に設定
'※黒:RGB( 0, 0, 0)、白:RGB( 255, 255, 255)、緑:RGB( 0, 255, 0)、青:RGB( 0, 0, 255)、黄:RGB( 255, 255, 0)、紫:RGB( 255, 0, 255)、橙:RGB( 0, 255, 255)

※まだ途中なのですが、回答欄に入力可能な文字数を超えてしまいますので、残りは又後で投稿させて頂きます。

回答No.2

kagakusuki

>できましたら、文字の色、背景の色、枠組の線、文字の位置の変更、等についてのコードなど併せ教えていただけましたらうれしいです。

という点に関して調べていたため時間が掛かりました。VBAでオートシェイプ(図形)の設定を行うコードの内、主に使う事がありそうだと私が独断で思ったもののコードには次の様なものがあります。
　おそらく質問者様にとっては不要な情報も多々あるかと思いますが、質問者様以外にも図形の設定を行う際のコードを知りたいと考える人間は多数おられると思いますので、そういった方々のためにも、VBAでオートシェイプ(図形)の設定を行うコードを、ここでまとめて紹介しておこうと思います。

【選択済みの図形の設定を行う場合のコード】

Selection.Caption = "テキスト入力" '図形内のテキストを"テキスト入力"にする

'図形内のテキストの垂直方向の配置=上
With Selection.ShapeRange.TextFrame2
.VerticalAnchor = msoAnchorTop
.HorizontalAnchor = msoAnchorNone
End With

'図形内のテキストの垂直方向の配置=上下中央
With Selection.ShapeRange.TextFrame2
.VerticalAnchor = msoAnchorMiddle
.HorizontalAnchor = msoAnchorNone
End With

'図形内のテキストの垂直方向の配置=下
With Selection.ShapeRange.TextFrame2
.VerticalAnchor = msoAnchorBottom
.HorizontalAnchor = msoAnchorNone
End With

'図形内のテキストの垂直方向の配置=上中央
With Selection.ShapeRange.TextFrame2
.VerticalAnchor = msoAnchorTop
.HorizontalAnchor = msoAnchorCenter
End With

'図形内のテキストの垂直方向の配置=中心
With Selection.ShapeRange.TextFrame2
.VerticalAnchor = msoAnchorMiddle
.HorizontalAnchor = msoAnchorCenter
End With

'図形内のテキストの垂直方向の配置=下中央
With Selection.ShapeRange.TextFrame2
.VerticalAnchor = msoAnchorBottom
.HorizontalAnchor = msoAnchorCenter
End With

'図形内のテキストの水平方向の配置=左揃え
With Selection.ShapeRange.TextFrame2
.HorizontalAnchor = msoAnchorNone
.TextRange.ParagraphFormat.Alignment = msoAlignLeft
End With

'図形内のテキストの水平方向の配置=中央揃え
Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter

'図形内のテキストの水平方向の配置=右揃え
With Selection.ShapeRange.TextFrame2
.HorizontalAnchor = msoAnchorNone
.TextRange.ParagraphFormat.Alignment = msoAlignRight
End With

Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 10.5 '図形内のテキストのフォントサイズを10.5ptに設定
Selection.Font.Bold = True '図形内のテキスト太字
Selection.Font.Bold = False '図形内のテキスト太字解除
Selection.Font.Italic = True '図形内のテキスト斜体
Selection.Font.Italic = False '図形内のテキスト斜体解除
Selection.ShapeRange.TextFrame2.TextRange.Font.NameFarEast = "ＭＳ Ｐゴシック" '図形内のテキストのフォントを"ＭＳ Ｐゴシック"にする
Selection.ShapeRange.TextFrame2.TextRange.Font.NameFarEast = "ＭＳ Ｐ明朝" '図形内のテキストのフォントを"ＭＳ Ｐ明朝"にする
Selection.ShapeRange.TextFrame2.Orientation = msoTextOrientationHorizontalRotatedFarEast '縦書き(半角文字含む)
Selection.ShapeRange.TextFrame2.Orientation = msoTextOrientationHorizontal '横書き
Selection.ShapeRange.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0) '文字色を赤に設定
'※黒:RGB( 0, 0, 0)、白:RGB( 255, 255, 255)、緑:RGB( 0, 255, 0)、青:RGB( 0, 0, 255)、黄:RGB( 255, 255, 0)、紫:RGB( 255, 0, 255)、橙:RGB( 0, 255, 255)

'テキストに合わせて図形のサイズを調整する(必ず折り返し無しと共に使用)
With Selection
.ShapeRange.TextFrame2.WordWrap = False '図形内でテキストを折り返さない
.AutoSize = 1 'テキストに合わせて図形のサイズを調整する
End With

'Selection.Visible = False '図形非表示
Selection.Visible = True '図形非表示の解除(選択あるいは指定が可能であればの話)
'↑※選択あるいは指定が可能であればの話です。
'　通常は非表示にした段階で選出来なくなるため、
'　グループ化等によりまだ表示されている図形と共にグループごと非表示の解除を行うのでもない限り、
'　図形が選択されていない扱いとなるためエラーとなります。

Selection.ShapeRange.Fill.Visible = True '塗りつぶしあり
Selection.ShapeRange.Fill.Visible = False '塗りつぶしなし
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0) '塗りつぶし色を赤に設定
'※黒:RGB( 0, 0, 0)、白:RGB( 255, 255, 255)、緑:RGB( 0, 255, 0)、青:RGB( 0, 0, 255)、黄:RGB( 255, 255, 0)、紫:RGB( 255, 0, 255)、橙:RGB( 0, 255, 255)

Selection.AutoSize = False 'テキストに合わせて図形のサイズを調整しない
Selection.ShapeRange.TextFrame2.WordWrap = True '図形内でテキストを折り返す
Selection.ShapeRange.TextFrame2.WordWrap = False '図形内でテキストを折り返さない
Selection.ShapeRange.TextFrame2.MarginLeft = 12.345 '図形内のテキストの左の余白を12.345ptに設定
Selection.ShapeRange.TextFrame2.MarginRight = 12.345 '図形内のテキストの右の余白を12.345ptに設定
Selection.ShapeRange.TextFrame2.MarginTop = 12.345 '図形内のテキストの上の余白を12.345ptに設定
Selection.ShapeRange.TextFrame2.MarginBottom = 12.345 '図形内のテキストの下の余白を12.345ptに設定

'テキストを図形からはみ出して表示する
With Selection.ShapeRange.TextFrame
.HorizontalOverflow = 0
.VerticalOverflow = 0
End With

'テキストを図形からはみ出して表示しない
With Selection.ShapeRange.TextFrame
.HorizontalOverflow = 1
.VerticalOverflow = 1
End With

※まだ途中なのですが、回答欄に入力可能な文字数を超えてしまいますので、残りは又後で投稿させて頂きます。

回答No.1

kagakusuki

>textboxの中の文字を大きくしたいのですが

との事ですが、そもそも質問者様のVBAではエラーとなってテキストボックスが作成されませんので、作成されない文字のサイズを変える事など出来ません。

set temp = worksheets("ツーリングダイヤ").shapes.addtextbox_(msotextorientstionhorizontal,65,k,65,17) ’駅名表示用BOX

の中のmsotextorientstionhorizontalとは何の事なのでしょうか？
　もしかしますと、msoTextOrientationHorizontalの間違いではないでしょうか？
　又、テキストの縦方向の位置を指定する箇所で、変数kの値が使用されている様ですが、そのkの値を定めている

k = .cells(j,+m,3).value’表示位置取得

という箇所の中でセル番号の指定の仕方が、Excelで使用可能な2次元のセル番号ではなく、3次元のセル番号となっているのは何故なのでしょうか？
　もしかしますと、未だ私が気付いていないバグが他にもあるかも知れません。
　これではVBAが動作致しません。
　後、別に間違いという訳では御座いませんが、

.line.visible = falue’透明
.fill.visible = falue

の2行は

with temp

の中に入れ子としているというのに、その直前の

temp.textframe.characters.text = worksheets("ツーリングダイヤ").cells(j,2).value’駅名転記

の行は、何故、態々

with temp

の中に入れずにおいておられるのでしょうか？

　それでそういったバグをどう直せば良いのかは後回しにして、とりあえず御質問の

>textboxの中の文字を大きくしたい

という事についてのみお伝えする事に致します。
　文字サイズは

[テキストボックスオブジェクト].TextFrame.Characters.Characters.Font.Size = [フォントサイズ]

で設定されますから、もしShape変数tempで規定されているテキストボックスのフォントサイズを20に設定する場合には、

temp.TextFrame.Characters.Characters.Font.Size = 20

という構文を付け加えれば良い訳です。
　そして

temp.TextFrame.Characters.Characters

の所までは

temp.textframe.characters.text = worksheets("ツーリングダイヤ").cells(j,2).value’駅名転記

の行と共通なのですから、

temp.textframe.characters.text = worksheets("ツーリングダイヤ").cells(j,2).value’駅名転記
with temp
.line.visible = falue’透明
.fill.visible = falue
end with

の部分を
with temp
with .textframe.characters
.text = worksheets("ツーリングダイヤ").cells(j,2).value’駅名転記
.Font.Size = 20
end with
.line.visible = falue’透明
.fill.visible = falue
end with

に変えれば良い訳です。

お礼

早速のご解答ありがとう御座います。
いろいろと不備なコードでの質問をいたしましてご迷惑をおかけしました。申し訳ありません。

「バグを直せば良いのかは後回しにしてとりあえず・・・・・」と言っていただきましたので、早速次のように、コードを追加してみましたが解決できませんでした。致命的な間違いをしているようです。原因が判明しません、すみませんもう一度、教えて頂けませんか。今回は、動作しているコードをコピーしました。（その中に今回のコードを追加してあります。）
-------------------------------
'------------駅名・キロ程転記・描画　--------

Dim temp As Shape
Dim j, m, k, t As Long

With Sheets("ツーリングダイヤ")
t = .Range("c110").Value

For j = 104 To t Step 1 '駅数の数NEXT
m = .Range("e99").varue '表示位置調整
k = .Cells(j + m, 3).Value '表示位置取得

Set temp = Worksheets("ツーリングダイヤ").Shapes.AddTextbox(msoTextOrientationHorizontal, 65, k, 65, 17) 'TEXTBOX駅名表示用
temp.TextFrame.Characters.text = Worksheets("ツーリングダイヤ").Cells(j, 2).Value 'BOXに駅名転記
temp.TextFrame.Characters.Characters.Font.Size = 20
With temp

.line.Visible = False
.Fill.Visible = False
End With
Next j
End With
-----------------------------
よろしくお願いいたします。