[[20110616230153]]　『図形に文字を入れる』（ほり）　ページの最後に飛ぶ

『図形に文字を入れる』（ほり）

 Sub 線100()
    Dim Bar As Shape
    Set Bar = ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("s39").Left, Range("s39").Top, Range("AA39").Left - Range("s39").Left, Range("s39").Height)

    Bar.Fill.ForeColor.SchemeColor = 2
    Bar.Fill.Transparency = 0.5

    Set Bar = ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("W42").Left, Range("W42").Top, Range("aj42").Left - Range("w42").Left, Range("w42").Height)

    Bar.Fill.ForeColor.SchemeColor = 2
    Bar.Fill.Transparency = 0.5
     Set Bar = ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("aa48").Left, Range("aa48").Top, Range("aj48").Left - Range("aa48").Left, Range("aa48").Height)

    Bar.Fill.ForeColor.SchemeColor = 2
    Bar.Fill.Transparency = 0.5
     Set Bar = ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("am57").Left, Range("am57").Top, Range("av57").Left - Range("am57").Left, Range("am57").Height)

    Bar.Fill.ForeColor.SchemeColor = 2
    Bar.Fill.Transparency = 0.5  
   Set Bar = ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("am57").Left, Range("am57").Top, Range("av57").Left - Range("am57").Left, Range("am57").Height)

    Bar.Fill.ForeColor.SchemeColor = 2
    Bar.Fill.Transparency = 0.5
End Sub    
で出てくるオートシェイプに同時に
文字列（あいうえ）等を入れるにはどのような文章を入れればよろしいでしょうか。
ボタンを押せば3本ほど線が出てその中に文字が入っていればいいのですが
探してもやり方がわかりません
よろしくお願いします。

 こんな感じで

    With Bar.DrawingObject
      .Text = "あいうえ"
      .Font.ColorIndex = 1
      .Font.Size = 10
    End With

 （ｍｏｍｏ）

助かりました。
基本がないので
２週間ほどはまっておりました。
ありがとうございます。

シートからの代入で完成なのですが

Sub 線100()

    Dim Bar As Shape
    Set Bar = ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("★").Left, Range("★").Top, Range("◎").Left - Range("★").Left, Range("★").Height)

    Bar.Fill.ForeColor.SchemeColor = 50
    Bar.Fill.Transparency = 0.6

     With Bar.DrawingObject

      .Text = "あああ"
      .Font.ColorIndex = 1
      .Font.Size = 14
    End With

  With Bar.DrawingObject.ShapeRange.Line
        .Visible = msoFalse
        .Weight = 0

    End With

    Set Bar = ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("△").Left, Range("△").Top, Range("○").Left - Range("△").Left, Range("△").Height)

    Bar.Fill.ForeColor.SchemeColor = 50
    Bar.Fill.Transparency = 0.6

    With Bar.DrawingObject
      .Text = ”いいい"
      .Font.ColorIndex = 1
      .Font.Size = 12
    End With

      With Bar.DrawingObject.ShapeRange.Line
        .Visible = msoFalse
        .Weight = 0

    End With

A１にｓ３９
A2にｓ３０
A3にS13
A4にS３５
と書いているところから

★△◎○マークのところにセルの値から数値を入れるにはどうすればいいのでしょうか？
セルのA1、A2・・・・・・の値は毎回変わります。

お時間があればご指導よろしくお願いします。

 セルA1に　S39　という文字列が入力されていると・・、

 dim r as range
 set r=Range("indirect(a1)")
 msgbox r.address

 上記の　Range("indirect(a1)")　でセルS39のRangeオブジェクトが取得できます。

 方法は、他にもありますけどね！！

 これで試してください。

 それから

 >With Bar.DrawingObject.ShapeRange.Line
 With Bar.Line
 これで同じです。確認して下さい。

 ichinose

ichinoseさん
やっと理解できました。
ありがとうございます。

ただ　　
.Text = "あああ"
のあああ部分をセルから拾おうとすると空白になってしまします。
どう記入すればよろしいでしょうか？

  .Text = "あああ"
      .Font.ColorIndex = 1
      .Font.Size = 14
    End With

 >あああ部分をセルから拾おうとすると空白になってしまします。
 どのようなコードを書くと　↑この現象に至るのですか？

 こういうことは、きちんと記述してください。

 ここでご自分がわからないことや体験したことを閲覧者にも体験できる
 記述をすること、これは、プログラミングする上で非常に大事なことですよ！！

 ichinose

 ichinose様
ご指導ありがとうございます。

こんな感じなんですがわかりますでしょうか？
よろしくお願いします。

Sub 線100()

    On Error Resume Next    
    Dim Bar As Shape
    Set Bar = ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("indirect(fa3)").Left, Range("indirect(fa3)").Top, Range("indirect(fb3)").Left - Range("indirect(fa3)").Left, Range("indirect(fa3)").Height)

    Bar.Fill.ForeColor.SchemeColor = 50
    Bar.Fill.Transparency = 0.6

     With Bar.DrawingObject

      .Text = Range("indirect(fa3)")
      .Font.ColorIndex = 1
      .Font.Size = 14
   　　 End With

   　　　With Bar.Line

        .Visible = msoFalse
        .Weight = 0

    End With

 新規ブックにて、
 標準モジュールに

 '==================================================================
 Sub Sample1()
    On Error Resume Next
    Range("a1").Value = "c10"
    Range("a2").Value = "c1"
    Range("c1").Value = "ichinose"
    MsgBox "a1,a2,c1のセルの内容を確認して下さい" & vbCrLf & _
           "セルc10の大きさに合わせて四角形を作成し、テキストとして、セルC1の内容を設定します" & vbCrLf & _
           "正常に作成されたら、コードを理解してください"

    Dim Bar As Shape
    Set Bar = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
                           Range("indirect(a1)").Left, _
                           Range("indirect(a1)").Top, _
                           Range("indirect(a1)").Width, _
                           Range("indirect(a1)").Height)

    With Bar.DrawingObject
       .Text = Range("indirect(a2)").Value
       .Font.ColorIndex = 1
       .Font.Size = 11
    End With
    On Error GoTo 0
 End Sub

 上記のsample1を実行してみてください。

 セルc10の大きさに合わせて四角形を作成し、テキストとして、セルC1の内容を設定します。

 これで考察してみてください。

 ichinose

ichinoseさん

お礼書き込んでいたのですが
失敗してました。すいません

無事完成できました。
ありがとうございました。

コメント返信：

[ 一覧(最新更新順) ]

[[20110616230153]] 『図形に文字を入れる』（ほり） ページの最後に飛ぶ

[[20110616230153]]　『図形に文字を入れる』（ほり）　ページの最後に飛ぶ