Interaktiv graf / Excel+VBA

Det bør måske tilføjes, at check-boksenes "SAND/FALSK" er i hhv. G2, G3, G4, I2, I3, I4.

Du skal være velkommen til at sende det - så kan jeg da forsøge - @-adr. under profil.

Skriv et svar, så jeg kan tildele point :) Tak for hjælpen.

Sub cmd_konsgraf_Klik()
Const kol1 = "D"
Const overSkRække = "11"
Dim sidsteRække As Long, kildeOmråde As Variant, diagramTitel As String
Dim periode As String, forkortet As String, p As Byte
Dim chkListe As Variant, ix As Byte, kol As Variant
    chkListe = Array("G2", "I2", "G3", "I3", "G4", "I4")
   
    sidsteRække = ActiveSheet.Range("I5").Value
    kildeOmråde = "A" & overSkRække & ":A" & CStr(sidsteRække) & ","
    diagramTitel = ""
   
    sletBeståendeDiagrammer
   
Rem Traverser chkListe
    For ix = 0 To UBound(chkListe)
        If Range(chkListe(ix)) = True Then
            periode = Range(kol1 & overSkRække).Offset(0, ix)
            p = InStr(periode, " ")
            If p > 0 Then
                forkortet = Left(periode, p + 1)
                forkortet = Replace(forkortet, " ", "")
            Else
                forkortet = periode
            End If
           
            If diagramTitel <> "" Then
                diagramTitel = diagramTitel + ", "
            End If
           
            diagramTitel = diagramTitel & forkortet
            kol = Chr(Asc(kol1) + ix)
            kildeOmråde = kildeOmråde + kol & overSkRække & ":" & kol & CStr(sidsteRække) & ","
        End If
    Next ix
   
    fremstilDiagram diagramTitel, Left(kildeOmråde, Len(kildeOmråde) - 1)  'fjern sidste ,
End Sub
Private Sub sletBeståendeDiagrammer()
    For Each dia In ActiveSheet.ChartObjects
        dia.Delete
    Next dia
End Sub
Private Sub fremstilDiagram(diagramTitel, kildeOmråde)
Dim diaNavn As String
    kopierFraSkabelon
    ActiveSheet.Paste
   
    ActiveSheet.ChartObjects(1).Activate
    ActiveChart.ChartArea.Select

    ActiveChart.SetSourceData Source:=Sheets("Graf").Range(kildeOmråde), PlotBy:=xlColumns
   
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = diagramTitel
    End With
End Sub
Private Sub kopierFraSkabelon()
Dim antalDia As Byte
    antalDia = ActiveWorkbook.Sheets("DiagramSkabelon").ChartObjects.Count
   
    If antalDia > 0 Then
        ActiveWorkbook.Sheets("DiagramSkabelon").ChartObjects(1).Copy
    End If
End Sub