Bonjour,

 

J’aimerais modifier une macro d’un fichier Excel que j’ai récupéré.

Cette macro crée un graphique dans l’onglet EVALUATION DES RISQUES sur la base de données des colonnes F,G,H,I de l’onglet SAISIE DES RISQUES.

J’aimerais que la macro prenne comme source les colonnes L,M au lieux des colonnes H,I.

Que dois-je modifier dans la macro ci-dessous :

 

Sub bubbles()

Dim bubble_breite As Integer

Dim bubble_hoehe As Integer

Dim fontcolor_bubble As String

Dim fontstyle_bubble As String

 

Dim delta_x As Double

Dim delta_y As Double

Dim delta_delta_x As Double

Dim delta_delta_y As Double

Dim upper_left_x As Double

Dim upper_left_y As Double

 

' sti: variable riskono und eingeführt

Dim risikono(100) As Integer

Dim wahrscheinlichkeit(100) As Integer

Dim auswirkung(100) As Integer

Dim counter(5, 5) As Integer

Dim x As Integer

Dim y As Integer

Dim k As Double

Dim AnzahlEintraege As Integer

Dim AnzahlT As Integer

Dim t As String

 

' Initalisierungen

bubble_breite = 18

bubble_hoehe = 18

fontcolor_bubble = 1

fontstyle_bubble = "Standard"

 

' counter zuruecksetzen

  For i = 0 To 5

    For j = 0 To 5

      counter(i, j) = 0

    Next j

  Next i

 

' bubbles loeschen

  Call erase_bubbles

   

' Anzahl Risiken

  AnzahlEintraege = WorksheetFunction.CountIf(Sheets("SAISIE DES RISQUES").Range("A4:A205"), ">0")

 

' Anzahl Zeitperioden T

  AnzahlT = 2

  'WorksheetFunction.CountIf(Sheets("SAISIE DES RISQUES").Range("F4:Z4"), "*SM*")

  activeCol = 4 + (AnzahlT * 2)

 

For k = 1 To AnzahlT

    'daten auslesen

    For i = 1 To 100

    ' sti: variable risikono eingeführt und neue abfrage für top risiken

    risikono(i) = CInt(Sheets("SAISIE DES RISQUES").Cells(i + 3, 1).Value)

    wahrscheinlichkeit(i) = 0

    auswirkung(i) = 0

    If Sheets("SAISIE DES RISQUES").Cells(i + 3, 5).Value = "oui" Then

       If Sheets("SAISIE DES RISQUES").Cells(i + 3, activeCol).Value = " " Then wahrscheinlichkeit(i) = 0 Else wahrscheinlichkeit(i) = CInt(Sheets("SAISIE DES RISQUES").Cells(i + 3, activeCol).Value)

       If Sheets("SAISIE DES RISQUES").Cells(i + 3, activeCol + 1).Value = " " Then auswirkung(i) = 0 Else auswirkung(i) = CInt(Sheets("SAISIE DES RISQUES").Cells(i + 3, activeCol + 1).Value)

    End If

    Next i

   

' bubbles zeichnen

    upper_left_x = Sheets("MODELE").Cells(4, 3).Left

    upper_left_y = Sheets("MODELE").Cells(4, 3).Top

    delta_x = Sheets("MODELE").Cells(4, 3).Width

    delta_y = Sheets("MODELE").Cells(4, 3).Height

    delta_delta_x = bubble_breite + (delta_x - 3 * bubble_breite) / 10

    upper_left_x = upper_left_x + (delta_x - 3 * bubble_breite) / 10

    delta_delta_y = bubble_hoehe + (delta_y - 3 * bubble_hoehe) / 10

    upper_left_y = upper_left_y + (delta_y - 3 * bubble_hoehe) / 10

    i = 1

   

    For u = 1 To AnzahlEintraege

        x = upper_left_x + (auswirkung(i) - 1) * delta_x

        y = upper_left_y + (5 - wahrscheinlichkeit(i)) * delta_y

        x = x + (counter(wahrscheinlichkeit(i), auswirkung(i)) Mod 4) * delta_delta_x

        y = y + ((counter(wahrscheinlichkeit(i), auswirkung(i)) - counter(wahrscheinlichkeit(i), auswirkung(i)) Mod 4) / 4) * delta_delta_y

       

        If wahrscheinlichkeit(i) = 0 Then

            counter(wahrscheinlichkeit(i), auswirkung(i)) = counter(wahrscheinlichkeit(i), auswirkung(i)) + 1

           

            Else

            Call add_bubble(x, y, bubble_breite, bubble_hoehe, risikono(i), k)

            counter(wahrscheinlichkeit(i), auswirkung(i)) = counter(wahrscheinlichkeit(i), auswirkung(i)) + 1

        End If

        i = i + 1

   

    Next u

    Cells(1, 1).Select

    activeCol = activeCol - 2

   

    

Next k

End Sub

 

Sub erase_bubbles()

    Sheets("EVALUATION DES RISQUES").Select

    Application.DisplayAlerts = False

    ActiveWindow.SelectedSheets.Delete

    Sheets("MODELE").Select

    Sheets("MODELE").Copy After:=Sheets("SAISIE DES RISQUES")

    Sheets("MODELE (2)").Select

    Sheets("MODELE (2)").Name = "EVALUATION DES RISQUES"

End Sub

 

Sub add_bubble(ByVal x As Double, ByVal y As Double, ByVal bubble_breite, ByVal bubble_hoehe, ByVal z As Integer, ByVal k As Double)

       

    If k = 1 Then

        bubble_breite = 18

        bubble_hoehe = 18

        Fontfarbe_bubble = 2

        fontstyle_bubble = "Bold"

    Else

        Fontfarbe_bubble = 16

    End If

           

        ActiveSheet.Shapes.AddShape(msoShapeOval, x, y, bubble_breite, bubble_hoehe).Select

        Selection.Characters.Text = z

        Selection.ShapeRange.Line.Transparency = 1

       

     ' Farbe für Bubbles bestimmen

    

    Select Case k

        Case 1

            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(67, 69, 42)

        Case 2

            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(196, 189, 151)

            Selection.ShapeRange.ZOrder (1)

        Case 3

            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(238, 236, 225)

            Selection.ShapeRange.ZOrder (1)

    End Select

   

 

    With Selection.Characters(Start:=0, Length:=2).Font

        .Name = "Arial"

        .FontStyle = fontstyle_bubble

        .Size = 8

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ColorIndex = Fontfarbe_bubble

    End With

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .Orientation = xlHorizontal

        .AutoSize = False

    End With

End Sub

Bonsoir verdanto,

 

Sans doute le sujet n'est-il plus d'actualité...

 

Compte tenu de la complexité du code recopié ici (origine allemande ?) et sans fichier joint pour aider à éclaircir un peu le problème, je n'avais d'abord pas l'intention de répondre à ta demande à vrai dire...

 

Mais juste au cas où (et avec un peu de chance !), je dirai que la solution se trouve dans ce morceau de code :

 

' Anzahl Zeitperioden T

  AnzahlT = 2
  'WorksheetFunction.CountIf(Sheets("SAISIE DES RISQUES").Range("F4:Z4"), "*SM*")
  activeCol = 4 + (AnzahlT * 2)

Ici, la variable "activeCol" prend une valeur de 4 + (2 * 2) = 8

(ce qui correspond en théorie à la colonne H, 8ème colonne)

 

Je pense qu'en affectant une valeur de 12 (soit colonne L), la suite du code devrait pouvoir répondre à ton besoin. ATTENTION, cependant : une telle modification impliquera forcément d'autres répercutions ailleurs dans ton code !!!

 

Te souhaitant bonne chance,

Bien cordialement,