1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
| Private Sub Tournesol()
'Déclaration des variables
Dim NouvelleFeuille As Worksheet
Dim NumLigne As Integer '-> ligne dans onglet "parametrage" (tableau d'entrée)
Dim NumCol As Integer '-> Variable pour chercher le nb de colonnes dans lesquelles sont saisies des notes
' Variables pour numérotations des colonnes dans la boucle des critères
Dim i As Integer '-> colonne critère
Dim ToutesNotes As String '-> variable contenant l'ensemble des notes possibles
Dim Nbseuils As Integer '-> nb de seuils
Dim NbS As String '-> variable permettant d'afficher le nb de seuils
'Insère une feuille de calcul avant la dernière feuille du classeur
Set NouvelleFeuille = ThisWorkbook.Worksheets.Add(After:=Worksheets("parametrage"))
'Titre de la 1ere cellule et fusion
NouvelleFeuille.Cells(1, 1) = "ACTIVITES /" + Chr(10) + "Aspects environnementaux"
With NouvelleFeuille
.Range(.Cells(1, 1), .Cells(2, 1)).Merge '-> fusion des cellules
End With
'Boucle sur les lignes du tableau d'entrée
'Determination du numero de la 1ere ligne à considerer dans la boucle
NumLigne = 2
'Numero de la premiere colonne à remplir ds tableau de sortie
i = 1
Do While Worksheets("Parametrage").Cells(NumLigne, 1) <> "" And Worksheets("Parametrage").Cells(NumLigne, 2) <> ""
'Détermination de la 1ere case à considérer pour récupérer les notes de chaque critère
NumCol = 2
'récupération d'infos dans l'onglet paramétrage => OK
Do While [...Création de la variable ToutesNotes utilisée + loin...] Loop
'comptage du nb de colonnes utilisées dans l'onglet parametrage
Nbseuils = Worksheets("Parametrage").Cells(NumLigne, 2).End(xlToRight).Column - 2
'Titres colonnes 2ème ligne => c'est là que ça coince et que j'arrive pas à faire une boucle correcte.
NbS = Nbseuils
NouvelleFeuille.Cells(2, i + Nbseuils) = "Seuil " + NbS
'Mise en forme titre ligne 1
NouvelleFeuille.Cells(1, i + 1) _
= Worksheets("Parametrage").Cells(NumLigne, 1) + Chr(10) + "(Notes : " + ToutesNotes + ")"
With NouvelleFeuille
.Range(.Cells(1, i + 1), .Cells(1, i + Nbseuils)).Merge '-> fusion des cellules
End With
ToutesNotes = "" '-> réinitialisation de la variable avant la prochaine boucle
'passer à la ligne suivante dans le tableau d'entrée :
NumLigne = NumLigne + 1
i = i + Nbseuils
'Fin de la boucle
Loop
'Renomme la nouvelle feuille avec le nom de l'activité
ActiveSheet.Name = "Seuils de notation"
End Sub |
Partager