none
[Excel VBA] Shape color is not visible with Excel 2016, but is with Excel 2013 RRS feed

  • Question

  • Hi,

    I've made a code for studying function SIN and COS. It's like an analog clock that shows only second hand(Line shape).

    It works as expected with Excel 2013. But with Excel 2016, second hand(colored red) cannot be seen, only marks(both ends of Line) can be seen.

    I've reproduced this, in Windows 7, 8.1, and 10.

        
    Code:
     "prc_Show_AnalogClock" is executed by "btn_Show_AnalogClock_Click" in worksheet.
    Private Sub btn_Show_AnalogClock_Click()
        Call MyModule_1.prc_Show_AnalogClock
    End Sub

    ' --- for "Sleep" スリープ関数(API)の宣言
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    
    ' ---[10] Analog Clock (display second hand) (アナログ時計・秒針を表示:サイン、コサインの練習)
    Public Sub prc_Show_AnalogClock()
        Call prc_Clear_Clock    ' -- delete Oval and Line already exist: 既存の円と直線を削除
        Application.ScreenUpdating = True
        ' --- decide location of Cell C13: 位置の決定(セル C13 の座標:左上)
        Dim posX As Single, posY As Single
        posX = Range("C13").Left
        posY = Range("C13").Top
        ' --- get diameter of Oval: 円の直径を入力
        Dim inputString As String
        Dim myDiameter As Single    ' -- diameter of Oval: 円の直径
        'inputString = InputBox("円の直径(pixel)を入力して下さい。", "円の直径")
        inputString = InputBox("input diameter of circle", "diameter")
        If inputString = "" Then
            Exit Sub
        Else
            myDiameter = CSng(inputString)
        End If
        ' --- add shape Oval: 円(楕円:縦=横)を描く
        ActiveSheet.Shapes.AddShape(msoShapeOval, posX, posY, myDiameter, myDiameter).Select
        ' --- setting of Oval: 塗りつぶしの設定
        With Selection.ShapeRange
            .Fill.Visible = msoFalse ' -- 塗りつぶし無し
            .Line.ForeColor.RGB = RGB(0, 0, 255)    ' -- 線の色
            .Line.Weight = 1.5    ' -- 線の太さ
        End With
        ' --- starting point of second hand: 秒針の始点
        Dim startX As Single, startY As Single
        Dim endX As Single, endY As Single
        startX = posX + (myDiameter / 2)
        startY = posY + (myDiameter / 2)
        ' --- ending point of second hand: 秒針の終点(1秒ごとに変わる)
        Dim DurationSec As Integer ' -- how long display short hand: 持続時間(秒)
        Dim iSec As Integer
        'inputString = InputBox("表示時間(秒)を入力して下さい。", "表示時間(秒)")
        inputString = InputBox("input duration time(second)", "duration time")
        If (inputString = "") Then
            Exit Sub
        Else
            DurationSec = CInt(inputString)
        End If
        ' --- add/delete shape Line at interval of 1 sec: 1秒間隔で線(秒針)を描く(サイン、コサインの練習用)
        Dim mySec As Integer
        Dim myConst As Single
        myConst = 3.141592 / 180
        For mySec = 0 To DurationSec
            endX = Sin(6 * mySec * myConst) * (myDiameter / 2)
            endY = Cos(6 * mySec * myConst) * (myDiameter / 2)
            ' --- add Line: 秒針を描く
            ActiveSheet.Shapes.AddLine(startX, startY, startX + endX, startY - endY).Select
            With Selection.ShapeRange
                .Line.ForeColor.RGB = RGB(255, 0, 0)   ' -- color of Line: 線の色
                .Line.Weight = 1    ' -- weight of Line: 線の太さ
            End With
            DoEvents
            Application.ScreenUpdating = True
            ' --- delete Line after 1 second: 1秒待ってから、秒針を消す
            Sleep 1000  ' --● Sleep API declared on the top: モジュールの先頭でスリープ関数(API)を宣言している
            If (mySec < DurationSec) Then
                Selection.ShapeRange.Delete
            End If
        Next
        ' ---
        MsgBox "Clock stopped: 時計終了"
    End Sub
    ' --- delete Oval and Line already exist: 既存の円と直線を削除
    Private Sub prc_Clear_Clock()
        Dim myShape As Shape
        For Each myShape In ActiveSheet.Shapes
            'If (myShape.Type <> 12) And (myShape.Type <> 6) Then
            '    MsgBox "Shape Type=" & myShape.Type & Chr(13) & "Shape Name=" & myShape.Name
            'End If
            If (myShape.Type = 1) Or (myShape.Type = 9) Then
                myShape.Delete
            End If
        Next
    End Sub

    This needs two user input (using InputBox):
      1) diameter of circle(Shape Oval)
      2) duration time(seconds)

    I suppose it's a bug of Excel 2016.
    I hope you will try it with Excel 2016 and other version of Excel and inform its result.

    Thank you in advance.

    Regards.
    • Edited by Ashidacchi Friday, April 8, 2016 7:11 AM
    Friday, April 8, 2016 3:08 AM

Answers

  • Hi Ashidacchi,

    it seems that it is product issue. please give your feedback to Excel User Voice regarding this issue.

    I have provided a link below. kindly visit the link.

    Excel User Voice

    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.
    Click HERE to participate the survey.

    • Marked as answer by Ashidacchi Tuesday, April 12, 2016 11:07 PM
    Tuesday, April 12, 2016 10:39 AM
    Moderator

All replies

  • Hi, Ashidacchi

    I run your code at my side with Excel 2013 and 2016.

    I find the same result like you.

    but in Excel 2016 1 thing I find that when it stops at that time it shows the color.

    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.
    Click HERE to participate the survey.



    Friday, April 8, 2016 7:37 AM
    Moderator
  • Hi Deepak Panchal10,

    I appreciate your trial and report.
    Things are the same as you at my side. I forgot a picture you had inserted.
    I will check it further and wait for more people reproducing it, and finally feedback to Microsoft.

    Thank you again.

    Regards.

    Friday, April 8, 2016 8:05 AM
  • Hi, Ashidacchi

    >> the another thing I find that when we debug the code at that time the line color is also displayed.

    >> and one more thing that if don't delete that line i.e. if comment this line "Selection.ShapeRange.Delete".

    then also color of line is displayed. have a look.

    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.
    Click HERE to participate the survey.

    Friday, April 8, 2016 8:17 AM
    Moderator
  • Hi Deepak Panchal10,

    Thank you for testing.
    I've checked it already. Without deleting Line, it works as we expect, i.e. all red lines are displayed.

    With Excel 2016, red Line seems to be deleted before sleeping one second.

    Regards.
    Friday, April 8, 2016 8:26 AM
  • Hi Ashidacchi,

    it seems that it is product issue. please give your feedback to Excel User Voice regarding this issue.

    I have provided a link below. kindly visit the link.

    Excel User Voice

    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.
    Click HERE to participate the survey.

    • Marked as answer by Ashidacchi Tuesday, April 12, 2016 11:07 PM
    Tuesday, April 12, 2016 10:39 AM
    Moderator
  • Hi Deepak Panchal10,

    Thank you for advice.
    I've reproduced this various environments. So, I'll feedback it Excel User Voice.

    Regards.
    Tuesday, April 12, 2016 11:10 PM