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
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
