VBA Baloncuk Grafiği Bubble Chart

Ornek resimde gordugunuz gibi bir grafik yapimi icin kodlar paylasacagiz, kodlarla verilerin alinacagi yerleri saptamak kaydi ile yapilan bu grafigin kodlarini asagidan inceleyebilirsiniz, ayrica dosya ekte olacaktir.

Option Explicit

Sub CallAB()
    
    On Error Resume Next
    ActiveSheet.ChartObjects.Delete
    Err.Clear: On Error GoTo -1: On Error GoTo 0
    ActiveSheet.Shapes.AddChart 'Excel 2007 ve ustu versiyonlar icin...
    AssignBubbleSource ActiveSheet.ChartObjects(1), ActiveSheet.Range("A1:D5")
    
End Sub

Private Sub AssignBubbleSource(chtBblChart As ChartObject, rngChartSource As Range, Optional blnHeader As Boolean = True)
    
    Dim lngRow As Integer
    Dim lngIndex As Byte
    Dim wksSourceSheet As Worksheet
    
    Const NameColumn As Integer = 0     'isim kolon sayisi
    Const FirstColumn As Integer = 1    'X Degerleri
    Const SecondColumn As Integer = 2   'Y Degerleri
    Const ThirdColumn As Integer = 3    'Z Degerleri

    Set wksSourceSheet = rngChartSource.Parent
    With chtBblChart.Chart
        .ChartType = xlBubble3DEffect
    End With
    For lngIndex = 1 To chtBblChart.Chart.SeriesCollection.Count
        chtBblChart.Chart.SeriesCollection(1).Delete
    Next lngIndex
    
    lngIndex = 1
    
    For lngRow = rngChartSource.Row + Abs(blnHeader) To rngChartSource.Row + rngChartSource.Rows.Count - 1
        If wksSourceSheet.Cells(lngRow, rngChartSource.Column) = "" Then
            GoTo AddNextItem
        Else
            With chtBblChart.Chart
            .SeriesCollection.NewSeries
                With .SeriesCollection(lngIndex)
                    .XValues = "='" & wksSourceSheet.Name & "'!R" & lngRow & "C" & (rngChartSource.Column + FirstColumn)
                    .Values = "='" & wksSourceSheet.Name & "'!R" & lngRow & "C" & (rngChartSource.Column + SecondColumn)
                    .BubbleSizes = "='" & wksSourceSheet.Name & "'!R" & lngRow & "C" & (rngChartSource.Column + ThirdColumn)
                    .Name = wksSourceSheet.Cells(lngRow, rngChartSource.Column + NameColumn).Value '"='" & strSourceShtName & "'!R" & lngRow & "C" & (rngChartSource.Column + NameColumn)
                End With
            End With
        End If
        lngIndex = lngIndex + 1
AddNextItem:
    Next lngRow
    With chtBblChart.Chart
        .ChartType = xlBubble3DEffect
        .SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis) 'Excel 2007 ve ustu versiyonlar icin...
        .SetElement (msoElementPrimaryValueAxisTitleRotated) 'Excel 2007 ve ustu versiyonlar icin...
        .SetElement (msoElementDataLabelRight) 'Excel 2007 ve ustu versiyonlar icin...
        If blnHeader Then
            .Axes(1, 1).AxisTitle.Text = rngChartSource.Cells(1, rngChartSource.Column + FirstColumn).Value
            .Axes(2, 1).AxisTitle.Text = rngChartSource.Cells(1, rngChartSource.Column + SecondColumn).Value
        End If
    End With
    lngRow = Empty
    lngIndex = Empty
    Set wksSourceSheet = Nothing
    
End Sub

VBA Baloncuk Grafiği Bubble Chart

Yazar: mmustafaaslan

2004 yilindan itibaren ozel bir sirketin finans departmaninda calismaktadir. Kendini excel, visual basic kullaniminda gelistirmis olan yazarimiz; Meslegi geregi SAP konusunda ileri derecede bilgilidir.

Bir Cevap Yazın

E-posta hesabınız yayımlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir


3 + 5 =