Show Blank Chart or 'No Data' on Empty chart

Vishesh's picture

'Copy the following code in a general module and call TestRun function. Alternatively you can download the attachment and test run it.

Sub TestRun()
    Call NoDataInCharts(ThisWorkbook.ActiveSheet, "shpA1B", "Data Not Available")
End Sub
 
Private Sub NoDataInCharts(wks As Worksheet, Optional strShapeName As String = "shpNoData", Optional strShapeString As String = "No Data")
    Dim objChart            As ChartObject
    Dim sngTopLeftOffset    As Single
 
    sngTopLeftOffset = 3
    For Each objChart In wks.ChartObjects
        On Error Resume Next
            objChart.Chart.Shapes(strShapeName).Delete
        On Error GoTo 0
        If blnDataVisible(objChart) = False Then
            Call CreateShapeInChart(objChart, strShapeName, strShapeString, sngTopLeftOffset, sngTopLeftOffset, _
                objChart.Width - (sngTopLeftOffset * 3), objChart.Height - (sngTopLeftOffset * 3))
        End If
    Next objChart
    Set objChart = Nothing
End Sub
 
Private Function blnDataVisible(objChart As ChartObject) As Boolean
    Dim srs         As Series
    Dim blnData     As Boolean
 
    For Each srs In objChart.Chart.SeriesCollection
        If Application.WorksheetFunction.Max(srs.Values) <> 0 Or Application.WorksheetFunction.Min(srs.Values) <> 0 Then
            blnData = True
            GoTo ExitF
        End If
    Next srs
ExitF:
    Set srs = Nothing
    blnDataVisible = blnData
End Function
 
Private Sub CreateShapeInChart(objChart As ChartObject, strShapeName As String, strShapeText As String, sngLeft As Single, sngTop As Single, sngWidth As Single, sngHeight As Single)
    With objChart.Chart.Shapes.AddShape(msoShapeRectangle, sngLeft, sngTop, sngWidth, Abs(sngHeight))
        .Name = strShapeName
        .BackgroundStyle = msoBackgroundStylePreset1
        .Line.Visible = msoFalse
        .TextFrame.HorizontalAlignment = xlHAlignCenter
        .TextFrame.VerticalAlignment = xlVAlignCenter
        With .TextFrame.Characters
            .Text = strShapeText
            .Font.Color = 12611584
            .Font.Size = 28
            .Font.Bold = True
        End With
    End With
End Sub

Chart-Zoomer

AttachmentSize
NoDataInChart.xls46 KB