problem printing after making changes to a shape when using

[ABabeNChrist]

I’m using a rounded rectangle shape on the outer edge of a cell that contains linked test from another sheet. When I attempt to make changes to the color line and glow of the rounded rectangle shape using code, it does not print as it appears on the worksheet. If I were to delete the shape and then design a new one as the previous one using the normal standard procedure from the tool bar ribbon, it works and print OK. The problem seems to occur when using code. The reason I use code is because I have numerous sheets that are formatted the same and by using the code I am able to make changes to many sheets at once by using a name range for selection. I attached 2 different JPEG a before and after.

Before print.JPG

After print.JPG

[HansV]

What is the relevant part of the code you're using? It's difficult to answer your question if we don't have the slightest idea how you're changing the shapes.

[ABabeNChrist]

I use a command button with option buttons for the line shape color using this code.

Code: Select all

    Dim wsh As Worksheet
    Dim lngColor As Long

    ActiveWorkbook.Protect PassWord:="", Structure:=False, Windows:=False
    
    If OptionButton6 Then
        lngColor = ShowColor
        If lngColor = -1 Then
            MsgBox "You didn't select a color!", vbExclamation
            Exit Sub
        End If
    End If

    Application.ScreenUpdating = False
    With Worksheets("Cover Page").Shapes.Range(Array("Rounded Rectangle 3", _
                                                     "Rectangle 5")).Line

        Select Case True

        Case OptionButton1.Value
            .ForeColor.RGB = RGB(146, 208, 80)

        Case OptionButton2.Value
            .ForeColor.RGB = RGB(120, 220, 255)

        Case OptionButton3.Value
            .ForeColor.RGB = RGB(216, 216, 216)

        Case OptionButton4.Value
            .ForeColor.RGB = RGB(255, 220, 110)

        Case OptionButton5.Value
            .ForeColor.RGB = RGB(250, 100, 95)

        Case OptionButton6.Value
            .ForeColor.RGB = lngColor

        End Select
    End With


    With Worksheets("Color Setting").Shapes.Range(Array("Rounded Rectangle 1")).Line

        Select Case True

        Case OptionButton1.Value
            .ForeColor.RGB = RGB(146, 208, 80)

        Case OptionButton2.Value
            .ForeColor.RGB = RGB(120, 220, 255)

        Case OptionButton3.Value
            .ForeColor.RGB = RGB(216, 216, 216)

        Case OptionButton4.Value
            .ForeColor.RGB = RGB(255, 220, 110)

        Case OptionButton5.Value
            .ForeColor.RGB = RGB(250, 100, 95)

        Case OptionButton6.Value
            .ForeColor.RGB = lngColor

        End Select
    End With

    Application.ScreenUpdating = True
    
        ActiveWorkbook.Protect PassWord:="", Structure:=True, Windows:=True

I use a command button to make line shape visible or not visible using this code.

Code: Select all

    Dim shps As Shapes
    Dim shpRng As ShapeRange
    
    ActiveWorkbook.Protect PassWord:="", Structure:=False, Windows:=False

    Set shps = Sheets("Cover Page").Shapes
    Set shpRng = shps.Range(Array("Rounded Rectangle 3", "Rectangle 5"))
    shpRng.Visible = Not shpRng.Visible


    Set shps = Sheets("Color Setting").Shapes
    Set shpRng = shps.Range(Array("Rounded Rectangle 1"))
    shpRng.Visible = Not shpRng.Visible
    
        ActiveWorkbook.Protect PassWord:="", Structure:=True, Windows:=True

I use a command button with option buttons for the line shape glow color using this code.

Code: Select all

    Dim wsh As Worksheet
    Dim lngColor As Long
    Dim shpRange As ShapeRange
    
    ActiveWorkbook.Protect PassWord:="", Structure:=False, Windows:=False

    If OptionButton6 Then
        lngColor = ShowColor
        If lngColor = -1 Then
            MsgBox "You didn't select a color!", vbExclamation
            Exit Sub
        End If
    End If

    Application.ScreenUpdating = False

    Set shpRange = Sheets("Cover Page").Shapes.Range(Array("Rounded Rectangle 3", "Rectangle 5"))

    With shpRange.Glow

        Select Case True

        Case OptionButton1.Value
            .Color.RGB = RGB(146, 208, 80)

        Case OptionButton2.Value
            .Color.RGB = RGB(120, 220, 255)

        Case OptionButton3.Value
            .Color.RGB = RGB(216, 216, 216)

        Case OptionButton4.Value
            .Color.RGB = RGB(255, 220, 110)

        Case OptionButton5.Value
            .Color.RGB = RGB(250, 100, 95)

        Case OptionButton6.Value
            .Color.RGB = lngColor

        End Select
    End With


    Set shpRange = Sheets("Color Setting").Shapes.Range(Array("Rounded Rectangle 1"))

    With shpRange.Glow

        Select Case True

        Case OptionButton1.Value
            .Color.RGB = RGB(146, 208, 80)

        Case OptionButton2.Value
            .Color.RGB = RGB(120, 220, 255)

        Case OptionButton3.Value
            .Color.RGB = RGB(216, 216, 216)

        Case OptionButton4.Value
            .Color.RGB = RGB(255, 220, 110)

        Case OptionButton5.Value
            .Color.RGB = RGB(250, 100, 95)

        Case OptionButton6.Value
            .Color.RGB = lngColor

        End Select
    End With
    
    
    For Each wsh In Worksheets
        wsh.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, _
                    PassWord:="", UserInterFaceOnly:=True

        ActiveWorkbook.Protect PassWord:="", Structure:=True, Windows:=True

    Next wsh
    
    Application.ScreenUpdating = True
    

I then have the option of using 4 different command button that use this code below but with different Radius (1, 4, 8 and 12)

Code: Select all

    Dim shps As Shapes
    Dim shpRng As ShapeRange

    ActiveWorkbook.Protect PassWord:="", Structure:=False, Windows:=False

    Application.ScreenUpdating = False

    Set shps = Sheets("Cover Page").Shapes
    Set shpRng = shps.Range(Array("Rounded Rectangle 3", "Rectangle 5"))
    shpRng.Glow.Radius = 1  'This is for no glow
    
    
    Set shps = Sheets("Color Setting").Shapes
    Set shpRng = shps.Range(Array("Rounded Rectangle 1"))
     shpRng.Glow.Radius = 1  'This is for no glow

    Application.ScreenUpdating = True
    
        ActiveWorkbook.Protect PassWord:="", Structure:=True, Windows:=True

[HansV]

I'm sorry, I cannot reproduce the error in Excel 2007 SP2.

[ABabeNChrist]

Thank you Hans
It must be something on my end. I know it’s strange, I can’t see anywhere in the code that could cause this, and as I said it only happens when I make changes using the code. I’ll play around with it some more and see if I come up with any other possible clues of cause.