• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:vba textboxの文字のサイズの変更)

VBA TextBoxの文字のサイズを変更する方法

このQ&Aのポイント
  • Excel VBAで作成したTextBoxの中の文字のサイズを大きくする方法について教えてください。
  • TextBoxの文字の色、背景の色、枠組の線、文字の位置の変更を行うためのコードも教えていただけると嬉しいです。
  • 以下のコードに追加することで、TextBoxの文字のサイズを変更することができます。具体的なコードの追加方法について教えていただけますか?

質問者が選んだベストアンサー

  • ベストアンサー
  • kagakusuki
  • ベストアンサー率51% (2610/5101)
回答No.6

 回答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 = "MS Pゴシック" '図形内のテキストのフォントを"MS Pゴシック"にする .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 = "MS Pゴシック" '図形内のテキストのフォントを"MS Pゴシック"にする 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  以上です。

diwk85
質問者

お礼

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

全文を見る
すると、全ての回答が全文表示されます。

その他の回答 (5)

  • kagakusuki
  • ベストアンサー率51% (2610/5101)
回答No.5

>早速次のように、コードを追加してみましたが解決できませんでした。 との事ですので、取り敢えず、セルに入力する事で設定されるデータや、一部の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は、透明ですので必要はありませんが、できましたら、文字の色、背景の色、枠組の線、文字の位置の変更、等についてのコードなど併せ教えていただけましたらうれしいです。 との事でしたので、参考となる様に(テキストボックスは透明にしたままで)文字の色を赤、フォントの種類をMS Pゴシックとなる様にしておりますので、不要な様でしたら該当箇所を削除して下さい。  後、図形の位置は、通常のやり方では図形を囲む事が出来る最小の大きさを持つ長方形の左上の隅の頂点の位置で指定するものなのですが、透明なテキストボックスを使用しているというのに、その見えないボックスの左上の隅を基準にしてもあまり意味はない様にも思えましたし、折角縦一列に並べて配置しているというのに、駅名を表す文字列の右端の位置が、駅名の長さによってバラバラとなってしまっては見栄えが良くないようにも思えましたので、文字列の中心部分の位置で配置する位置を指定する様にしております。  その方法としては、まず縦横のサイズが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 ※まだ途中なのですが、回答欄に入力可能な文字数を超えてしまいますので、残りは又後で投稿させて頂きます。

全文を見る
すると、全ての回答が全文表示されます。
  • kagakusuki
  • ベストアンサー率51% (2610/5101)
回答No.4

 【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を使って行う場合のコードには、まだ他にも様々なものが御座いますが、私が調べたものは以上になります。

全文を見る
すると、全ての回答が全文表示されます。
  • kagakusuki
  • ベストアンサー率51% (2610/5101)
回答No.3

【選択済みの図形の設定を行う場合のコード】の続きです。 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 = "MS Pゴシック" '図形内のテキストのフォントを"MS Pゴシック"にする myShape.TextFrame2.TextRange.Font.NameFarEast = "MS P明朝" '図形内のテキストのフォントを"MS P明朝"にする 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) ※まだ途中なのですが、回答欄に入力可能な文字数を超えてしまいますので、残りは又後で投稿させて頂きます。

全文を見る
すると、全ての回答が全文表示されます。
  • kagakusuki
  • ベストアンサー率51% (2610/5101)
回答No.2

>できましたら、文字の色、背景の色、枠組の線、文字の位置の変更、等についてのコードなど併せ教えていただけましたらうれしいです。 という点に関して調べていたため時間が掛かりました。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 = "MS Pゴシック" '図形内のテキストのフォントを"MS Pゴシック"にする Selection.ShapeRange.TextFrame2.TextRange.Font.NameFarEast = "MS P明朝" '図形内のテキストのフォントを"MS P明朝"にする 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 ※まだ途中なのですが、回答欄に入力可能な文字数を超えてしまいますので、残りは又後で投稿させて頂きます。

全文を見る
すると、全ての回答が全文表示されます。
  • kagakusuki
  • ベストアンサー率51% (2610/5101)
回答No.1

>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 に変えれば良い訳です。

diwk85
質問者

お礼

早速のご解答ありがとう御座います。 いろいろと不備なコードでの質問をいたしましてご迷惑をおかけしました。申し訳ありません。 「バグを直せば良いのかは後回しにしてとりあえず・・・・・」と言っていただきましたので、早速次のように、コードを追加してみましたが解決できませんでした。致命的な間違いをしているようです。原因が判明しません、すみませんもう一度、教えて頂けませんか。今回は、動作しているコードをコピーしました。(その中に今回のコードを追加してあります。) ------------------------------- '------------駅名・キロ程転記・描画 -------- 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 ----------------------------- よろしくお願いいたします。

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • excel vba でtextboxの色、線を消す

    excel VBA の中でtext boxを作成しその中に文字を転記します。その際中の文字だけを表示し塗りつぶしなし、,線なしにしたいのですが何か方法はありませんか。手動で、図形書式の設定の、塗りつぶしなし,線なし、にすればできますが、次に作成するともとに戻ってしまいます。 コードは、下記のコードです。 dim temp as shape t = worksheets("ダイヤ").range("q93").value for j = 73 to t step 1'駅数の数NEXT m = worksheets("ダイヤ").range("f110").value’表示位置調整 k = worksheets("ダイヤ").cells(j + m.17).value’表示位置取得 set temp = worksheets("ダイ ヤ ").shapes.addtextboxmsotextorientationhorizontal.32,k,65,17)’textbox作成 temp. textframe.characters.text = worksheets("ダイヤ").cells(j,15).value、駅名転記 next j このコードで現在textboxを作成その中に文字を転記できますが、ボックスも表示されされてしまいま す、ボックスは消し、文字だけ表示することはできませんか。 何方か教えて頂けませんか。

  • excel VBA で条件の設定方を教えて下さい。

    今、斜線を引きその斜線データの最初のセルに数値で(1とか3とかの数値の)条件をつけて置き、その条件で、太さ、色等を変えて斜線を引きたいのですがうまくいきません。何方か教えて頂けませんか。 --------------------- dim myrange as range workheets("補助計算").range("c8:c47").value = worksheets("時刻").range("c8:c47").value workheets("補助計算").range("g8:h47").value = worksheets("時刻").range("g8:h47").value with worksheets("時刻")     v=worksheets("時刻").range("m2").value+12'描画本数     for i = 12 to v step 1'設定可能本数50本 set myrage = worksheets("補助計算").range("t3:t47") myrange.value = .range(.cells(3,i),.cells(48,i)).value for cnt = 75 to 113 step 2 e = worksheets("ダイヤ").cells(cnt,10).value       f = worksheets("ダイヤ").cells(cnt,11).value       g = worksheets("ダイヤ").cells(cnt+1,10).value       h = worksheets("ダイヤ").cells(cnt+1,11).value with worksheets("ダイヤ").shapes.addline(e,f,g,h) .line.weight = 1.1 .line.forecolor.rgb = vbblue end with next cnt next i end with ----------------------- 上記コードで、斜線が何本か引かれます、その際、データ元のセルに数値の条件、例えば、1 とか3とかの数値を入力されているときは、それによって、斜線の色、又は線の太さをかえたいのですが、指定の仕方は、時刻シートの時刻の上欄セルに、線の指定のセル、太さ指定のセルに別々に指定おき、それを参照して、線の色、太さをかえたいのですが、いろいろ試みましたがうまくいきません。上記コードにどのように追加コードをすればよいか何方か教えていただけませんか。できれば、線の色は3色以上設定できればありがたいです。、

  • EXCEL VBA SetFocus について教え

    ComboBox3 で郵便番号 住所 を選択して TextBox8 に表示 その後番地等を記入するため Private Sub ComboBox3_AfterUpdate() '郵便番号 住所 Workbooks("*****.xls").Activate Worksheets("**").Activate With UserForm7 No = .TextBox1.Value .TextBox7.Value = Mid(.ComboBox3.Text, 1, 8) Cells(No + 1, 7).Value = Mid(.ComboBox3.Text, 1, 8) '郵便番号 .TextBox8.Value = Mid(.ComboBox3.Text, 10) '住所 Cells(No + 1, 8).Value = .TextBox8.Value .ComboBox3.Visible = False .TextBox8.SetFocus .TextBox8.TabIndex = 4 .TextBox8.Text = Mid(.TextBox8.Text, 1) End With End Sub 上のコードで TextBox8 の テキストの最後にカーソルを移動したいのですが TextBox8 に カーソルは現れません。(UserForm7の最初のTextBox1にフォーカスが移る) UserForm8 にも 同様なコードが有りますがこちらは期待どうり動作します。 タブオーダーとかの違いは有りますが関係するのでしょうか  よろしくお願いします。

  • VBAのフォームでTextBoxがいっぱいある時

    Microsoft Excel 2000 for VBAのフォーム機能を使用して TextBox?に値が入力したらシートの指定したセルへ値が入るようにしたいんですが、 TextBoxがいっぱいあるため、以下のように非常に長いプログラムになってしまいました。 Private Sub TextBox1_Change() Sheets(sheetname).Cells(1, 横位置).Value = TextBox1.Value End Sub TextBox2~29は繰り返し Private Sub TextBox30_Change() Sheets(sheetname).Cells(30, 横位置).Value = TextBox30.Value End Sub 上手く配列化なんかでまとめる方法がありましたらアドバイスください。

  • TextBox.2 に Vlookupを入れる記述を教えて下さい。

    VBA初心者です。見よう見真似で売上伝票を作っています。 TextBox1には入力したコードをSheet2B1に書き込みたいです。 TextBox2にはTextBox1に入力したコードを見てVlookupのように、 商品リストから参照し、TextBox2に反映させたいです。 自分で作成してみたのですが、全く動きませんでした。 是非教えて下さい。宜しくお願い致します。 Private Sub CommandButton1_Click() With Worksheets("Sheet2") .Range("B1") = TextBox1.Text End With With Worksheets("商品リスト") TextBox2.Text = Application.WorksheetFunction.VLookup(Val(TextBox1.Value), RangeA, 2, False) End With End Sub

  • VBA ステートメントをまとめたい

    OSはXP Excelは2003を使用しています。 下記は組んだマクロの一部ですが、 ComboBoxが20まであるので、大変長いステートメントになってしまうので、 withの中を何とかまとめられないかと思い、こちらで教えて頂きたく書き込みました。 説明不足のところは追記致しますので、 何卒、よろしくお願い致します。 With ws 'Cells(行,列)  If ComboBox1 <> "" Then Cells(i + 1, 1) = TextBox1.Value '日付 Cells(i + 1, 2) = TextBox2.Value '伝票No. Cells(i + 1, 24) = TextBox3.Value '郵便番号 Cells(i + 1, 25) = TextBox4.Value '住所 Cells(i + 1, 3) = TextBox5.Value '社名 Cells(i + 1, 4) = TextBox6.Value '担当者名 Cells(i + 1, 18) = TextBox601.Value '税抜合計 Cells(i + 1, 19) = TextBox602.Value '消費税 Cells(i + 1, 20) = TextBox603.Value '合計 Cells(i + 1, 22) = TextBox701.Value '備考 Cells(i + 1, 23) = TextBox702.Value '未定 '------------------------------------------------------ Cells(i + 1, 6) = ComboBox1.Value '商品コード Cells(i + 1, 7) = TextBox11.Value 'メーカー名 Cells(i + 1, 8) = TextBox12.Value 'ModelNo. Cells(i + 1, 9) = TextBox13.Value '品名(英 Cells(i + 1, 10) = TextBox14.Value '品名(日 Cells(i + 1, 11) = TextBox15.Value '仕上(英 Cells(i + 1, 12) = TextBox16.Value '仕上(日 Cells(i + 1, 13) = TextBox17.Value '単価 Cells(i + 1, 14) = TextBox18.Value '掛け率 Cells(i + 1, 15) = TextBox19.Value '売価 Cells(i + 1, 16) = TextBox20.Value '数量 Cells(i + 1, 17) = TextBox21.Value '小計 Cells(i + 1, 21) = TextBox22.Value '社内コメント '---------------------------------------------------- '---------------------------------------------------- If ComboBox2 <> "" Then Cells(i + 2, 1) = TextBox1.Value '日付 Cells(i + 2, 2) = TextBox2.Value '伝票No. Cells(i + 2, 24) = TextBox3.Value '郵便番号 Cells(i + 2, 25) = TextBox4.Value '住所 Cells(i + 2, 3) = TextBox5.Value '社名 Cells(i + 2, 4) = TextBox6.Value '担当者名 Cells(i + 2, 18) = TextBox601.Value '税抜合計 Cells(i + 2, 19) = TextBox602.Value '消費税 Cells(i + 2, 20) = TextBox603.Value '合計 Cells(i + 2, 22) = TextBox701.Value '備考 Cells(i + 2, 23) = TextBox702.Value '未定 '------------------------------------------------------ Cells(i + 2, 6) = ComboBox2.Value '商品コード Cells(i + 2, 7) = TextBox31.Value 'メーカー名 Cells(i + 2, 8) = TextBox32.Value 'ModelNo. Cells(i + 2, 9) = TextBox33.Value '品名(英 Cells(i + 2, 10) = TextBox34.Value '品名(日 Cells(i + 2, 11) = TextBox35.Value '仕上(英 Cells(i + 2, 12) = TextBox36.Value '仕上(日 Cells(i + 2, 13) = TextBox37.Value '単価 Cells(i + 2, 14) = TextBox38.Value '掛け率 Cells(i + 2, 15) = TextBox39.Value '売価 Cells(i + 2, 16) = TextBox40.Value '数量 Cells(i + 2, 17) = TextBox41.Value '小計 Cells(i + 2, 21) = TextBox42.Value '社内コメント End If End If

  • このVBA、もうちょっとシンプルにできないですか?

    自力でVBAを書いてみたのですが、長くなってしまいました。 もうちょっとシンプルにするアイディアがあればお願いします。 やりたいことは、 (1)ユーザーフォームのテキストボックス内が空欄だったら「無視」 (2)テキストボックスの中が空欄でなければ「書き込み」 以上のことをやりたいのですが、テキストボックスが6種類あるので単純に記述すると結構長くなってしまいました。 特に問題がなければ、その旨をお願いします。 If TextBox1 = "" Then If TextBox2 = "" Then If TextBox3 = "" Then If TextBox4 = "" Then If TextBox5 = "" Then If TextBox6 = "" Then MsgBox ("得点が入力されていません。") ElseIf TextBox6 <> "" Then Sheets("総合(得点)").Cells(t + 9, u) = TextBox6.Value End If ElseIf TextBox5 <> "" Then Sheets("総合(得点)").Cells(t + 8, u) = TextBox5.Value ElseIf TextBox6 <> "" Then Sheets("総合(得点)").Cells(t + 9, u) = TextBox6.Value End If End If ElseIf TextBox4 <> "" Then Sheets("総合(得点)").Cells(t + 7, u) = TextBox4.Value If TextBox5 <> "" Then Sheets("総合(得点)").Cells(t + 8, u) = TextBox5.Value If TextBox6 <> "" Then Sheets("総合(得点)").Cells(t + 9, u) = TextBox6.Value End If End If End If ElseIf TextBox3 <> "" Then Sheets("総合(得点)").Cells(t + 6, u) = TextBox3.Value If TextBox4 <> "" Then Sheets("総合(得点)").Cells(t + 7, u) = TextBox4.Value If TextBox5 <> "" Then Sheets("総合(得点)").Cells(t + 8, u) = TextBox5.Value If TextBox6 <> "" Then Sheets("総合(得点)").Cells(t + 9, u) = TextBox6.Value End If End If End If End If ElseIf TextBox2 <> "" Then Sheets("総合(得点)").Cells(t + 5, u) = TextBox2.Value If TextBox3 <> "" Then Sheets("総合(得点)").Cells(t + 6, u) = TextBox3.Value If TextBox4 <> "" Then Sheets("総合(得点)").Cells(t + 7, u) = TextBox4.Value If TextBox5 <> "" Then Sheets("総合(得点)").Cells(t + 8, u) = TextBox5.Value ・ ・ ・ こんな感じで規則的に記述しただけです。(文字数が多いので最後は省略しました) 段差がなくて見づらいですが、宜しくお願いします。

  • VBA  コードをスマートに

    下記のコードをスマートにしたいのですが どのようにすれば いいですか? アドバイスをお願いします。 Worksheets("20年5月").Cells(2, 6).Value = Worksheets("20年4月").Cells(i, 6).Value Worksheets("20年6月").Cells(2, 6).Value = Worksheets("20年5月").Cells(i, 6).Value Worksheets("20年7月").Cells(2, 6).Value = Worksheets("20年6月").Cells(i, 6).Value Worksheets("20年8月").Cells(2, 6).Value = Worksheets("20年7月").Cells(i, 6).Value Worksheets("20年9月").Cells(2, 6).Value = Worksheets("20年8月").Cells(i, 6).Value Worksheets("20年10月").Cells(2, 6).Value = Worksheets("20年9月").Cells(i, 6).Value Worksheets("20年11月").Cells(2, 6).Value = Worksheets("20年10月").Cells(i, 6).Value Worksheets("20年12月").Cells(2, 6).Value = Worksheets("20年11月").Cells(i, 6).Value Worksheets("21年1月").Cells(2, 6).Value = Worksheets("20年12月").Cells(i, 6).Value Worksheets("21年2月").Cells(2, 6).Value = Worksheets("21年1月").Cells(i, 6).Value Worksheets("21年3月").Cells(2, 6).Value = Worksheets("21年2月").Cells(i, 6).Value

  • ユーザーフォームをWorksheet上で表示

    数日前、このカテゴリで相談した事の続きです。 以前の相談は、次の通りです。 http://okwave.jp/qa/q8892460.html この相談の中で出来たことは 1 ユーザーフォームを保存終了 2 Worksheet上にボタンを作成、そのボタンをクリックでユーザーフォームを表示 以上のことはできました。 作成したコードは次のとおりです。   '// Private Sub UserForm_Initialize() With Worksheets("Sheet1")  TextBox1 = .Cells(1, 1).Value  TextBox2 = .Cells(2, 1).Value TextBox3 = .Cells(3, 1).Value TextBox4 = .Cells(4, 1).Value TextBox5 = .Cells(5, 1).Value ).Value End With End Sub Private Sub UserForm_Terminate() With Worksheets("Sheet1")  .Cells(1, 1).Value = TextBox1  .Cells(2, 1).Value = TextBox2 .Cells(3, 1).Value = TextBox3 .Cells(4, 1).Value = TextBox4 .Cells(5, 1).Value = TextBox5 End With End Sub '// Private Sub cmdsyuuryo_Click() Unload Me End Sub Private Sub UserForm_Click() Myform.Show vbModeless End Sub そこで質問です。 現在Worksheet上にボタンを作成、クリックしてユーザーフォームを表示しているの を、WorksheetのセルA1(名前を記述してある)をクリックするだけでユーザーフォー ムを表示する方法はありませんか? ユーザーフォームの保存先は「Sheet1」のA1からA5までです。 できれば、この設定で具体的なコードの記述をお願いします。 Excel2013です。 よろしくお願いします。

  • vba変数のファイル名

    Cells(2, 3)にjを変数として、j.txtと書きたいのですが上手くいきません。 わかる方教えてください。 コードは以下のようになっています。よろしくお願いします。 Dim j As Integer For j = 1 To 8760 a = ThisWorkbook.Worksheets("Sheet2").Cells(j, "A").Value Worksheets("Sheet1").Range("1:26").Insert Worksheets("Sheet1").Cells(1, 1) = "void brightdata sky_dist" Worksheets("Sheet1").Cells(2, 1) = 7 Worksheets("Sheet1").Cells(2, 2) = "corr" Worksheets("Sheet1").Cells(2, 3) = " & j & ".txt” Next j

専門家に質問してみよう