none
rectangle format not working RRS feed

  • Question

  • Hi,

        ActiveSheet.Shapes.AddShape(msoShapeRectangle, 540, 15, 70, 20).Select
        Selection.Characters.Text = Range("A1").Value
        Selection.Characters.Font.ColorIndex = xlAutomatic
        
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, 675, 53, 70, 20).Select
        Selection.Characters.Text = Range("A2").Value
        Selection.Characters.Font.ColorIndex = xlAutomatic
        With shRECT
        .IncrementRotation 28
        End With
       

    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 405, 53, 70, 20).Select

    Selection.Characters.Text = Range("A3").Value
        Selection.Characters.Font.ColorIndex = xlAutomatic   With shRECT
        .IncrementRotation 330
        End With

    Not working , please help

    regards  

    Tuesday, March 15, 2016 2:26 PM

Answers

  • Hi, drsantoshsinghrathore

    >> I want all these rectangles with no fill with this code

    >> how to make it to show the range("B1").value while applying this code.

    >> I want to achieve the below with a shorter and better code,

     You can try the code below.

    Sub demo1()
    Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 100, 20, 200, 100)
      shp.Select
      Selection.ShapeRange.Fill.Visible = msoFalse
      Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Range("B1").Value
      shp.TextFrame.Characters.Font.ColorIndex = 1
    shp.TextFrame.HorizontalAlignment = xlHAlignCenter
     shp.TextFrame.VerticalAlignment = xlVAlignCenter
     End Sub
    

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place. <br/> Click <a href="http://support.microsoft.com/common/survey.aspx?showpage=1&scid=sw%3Ben%3B3559&theme=tech"> HERE</a> to participate the survey.

    Thursday, March 17, 2016 7:16 AM
    Moderator

All replies

  • You don't set shRECT to anything.

    Try code like this:

        Dim shRECT As Shape
        Set shRECT = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 540, 15, 70, 20)
        With shRECT
            .TextFrame.Characters.Text = Range("A1").Value
            .IncrementRotation 28
        End With


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Tuesday, March 15, 2016 3:35 PM
  • Hi,

    Thank you Hans Vogelaar,

    I tried both ways.

        Dim shRECT As Object
        Set shRECT = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 540, 15, 70, 20) 'session
        Selection.Characters.Text = Range("B1").Value
        Selection.Characters.Font.ColorIndex = xlAutomatic
     
        Set shRECT = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 675, 53, 70, 20) 'january
        Selection.Characters.Font.ColorIndex = xlAutomatic
        With shRECT
        .TextFrame.Characters.Text = Range("B2").Value
        .IncrementRotation 28
        End With
        Set shRECT = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 405, 53, 70, 20) 'december
        Selection.Characters.Font.ColorIndex = xlAutomatic
        With shRECT
        .TextFrame.Characters.Text = Range("B3").Value
        .IncrementRotation 330
        End With

    The value does not appear.

    Does it need to set separately for every shape.

    regards

    Wednesday, March 16, 2016 1:00 AM
  • Hi drsantoshsinghrathore,

    In your code snippet, you're trying to add three rectangles.

    When you said "The value does not appear", did you refer to all of the three, or just some one of them?



    • Edited by Jackie_ Wednesday, March 16, 2016 1:39 AM
    Wednesday, March 16, 2016 1:32 AM
  • Hi,

    Thank you Jackie_,

    I am adding many shapes. I posted few only for convenience.

    None of the value appears.

    regards


    Wednesday, March 16, 2016 1:44 AM
  • Hi, drsantoshsinghrathore

    hi have test your above posted code. I have make some changes in your code and test it again. now its working all the values of cells are now displaying in the shapes.

    Sub demo5()
     Dim shRECT As Object
         Set shRECT = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 540, 15, 70, 20) 'session
         Selection.Characters.Font.ColorIndex = xlAutomatic
         With shRECT
         .TextFrame.Characters.Text = Range("B1").Value
         .IncrementRotation 28
         End With
       
         Set shRECT = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 675, 53, 70, 20) 'january
         Selection.Characters.Font.ColorIndex = xlAutomatic
         With shRECT
         .TextFrame.Characters.Text = Range("B2").Value
         .IncrementRotation 28
         End With
         Set shRECT = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 405, 53, 70, 20) 'december
         Selection.Characters.Font.ColorIndex = xlAutomatic
         With shRECT
         .TextFrame.Characters.Text = Range("B3").Value
         .IncrementRotation 330
         End With
    End Sub

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place. <br/> Click <a href="http://support.microsoft.com/common/survey.aspx?showpage=1&scid=sw%3Ben%3B3559&theme=tech"> HERE</a> to participate the survey.

    Wednesday, March 16, 2016 2:52 AM
    Moderator
  • Hi Deepak Panchal,

    Thanks for your reply,

    I want all these rectangles with no fill with this code

    Selection.ShapeRange.Fill.Visible = msofalse

    I do not know how to make it to show the range("B1").value while applying this code.

    please help.

    regards

    Wednesday, March 16, 2016 1:39 PM
  • I want to achieve the below with a shorter and better code,

        ActiveSheet.Shapes.AddShape(msoShapeRectangle, 530, 15, 90, 20).Select
        Selection.ShapeRange.Fill.Visible = msoFalse
        Selection.ShapeRange.Line.Visible = msoFalse
        Selection.ShapeRange.IncrementRotation 0
         Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
        Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Range("b1").Value
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Font.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 0)
            .Transparency = 0
            .Solid
        End With
       
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters.ParagraphFormat
            .FirstLineIndent = 0
            .Alignment = msoAlignCenter
        End With
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Font
            .NameComplexScript = "+mn-cs"
            .NameFarEast = "+mn-ea"
            .Fill.Visible = msoTrue
            .Fill.ForeColor.RGB = RGB(0, 0, 0)
            .Fill.Transparency = 0
            .Fill.Solid
            .Size = 14
            .Name = "+mn-lt"
        End With
        
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, 675, 53, 70, 20).Select
        Selection.ShapeRange.Fill.Visible = msoFalse
        Selection.ShapeRange.Line.Visible = msoFalse
        Selection.ShapeRange.IncrementRotation 28
         Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
        Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Range("b2").Value
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Font.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 0)
            .Transparency = 0
            .Solid
        End With
       
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters.ParagraphFormat
            .FirstLineIndent = 0
            .Alignment = msoAlignCenter
        End With
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Font
            .NameComplexScript = "+mn-cs"
            .NameFarEast = "+mn-ea"
            .Fill.Visible = msoTrue
            .Fill.ForeColor.RGB = RGB(0, 0, 0)
            .Fill.Transparency = 0
            .Fill.Solid
            .Size = 14
            .Name = "+mn-lt"
        End With
        
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, 405, 53, 70, 20).Select
        Selection.ShapeRange.Fill.Visible = msoFalse
        Selection.ShapeRange.Line.Visible = msoFalse
        Selection.ShapeRange.IncrementRotation 330
         Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
        Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Range("b13").Value
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Font.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 0)
            .Transparency = 0
            .Solid
        End With
       
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters.ParagraphFormat
            .FirstLineIndent = 0
            .Alignment = msoAlignCenter
        End With
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Font
            .NameComplexScript = "+mn-cs"
            .NameFarEast = "+mn-ea"
            .Fill.Visible = msoTrue
            .Fill.ForeColor.RGB = RGB(0, 0, 0)
            .Fill.Transparency = 0
            .Fill.Solid
            .Size = 14
            .Name = "+mn-lt"
        End With

    And yes there are many of them.

    regards

    Wednesday, March 16, 2016 3:55 PM
  • Hi, drsantoshsinghrathore

    >> I want all these rectangles with no fill with this code

    >> how to make it to show the range("B1").value while applying this code.

    >> I want to achieve the below with a shorter and better code,

     You can try the code below.

    Sub demo1()
    Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 100, 20, 200, 100)
      shp.Select
      Selection.ShapeRange.Fill.Visible = msoFalse
      Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Range("B1").Value
      shp.TextFrame.Characters.Font.ColorIndex = 1
    shp.TextFrame.HorizontalAlignment = xlHAlignCenter
     shp.TextFrame.VerticalAlignment = xlVAlignCenter
     End Sub
    

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place. <br/> Click <a href="http://support.microsoft.com/common/survey.aspx?showpage=1&scid=sw%3Ben%3B3559&theme=tech"> HERE</a> to participate the survey.

    Thursday, March 17, 2016 7:16 AM
    Moderator
  • Thanks Deepak Panchal.
    Thursday, March 17, 2016 4:47 PM