Code VBA perdu ?

D'abord.. Bonjour ^^

Ensuite mon (gros) problème :
Excel m'a buggé alors qu'une userform était chargée et j'ai du forcer l'arrêt.
Maintenant quand j'ouvre à nouveau le fichier j'ai les messages suivants :
1. Des erreurs se sont produites au cours du chargement
2. MVB : Impossible de charger ou decharger cet objet

Là il propose des "réparations" pour utiliser le fichier, ce qui consiste à virer tout le projet VBA et j'ai "Projet Visual Basic perdu". => Super !... :cry:

Vous l'aurez compris, j'aimerai savoir comment récupérer mon code (tout ou partie) afin de pas tout refaire. (bien sûr je n'avais de fichier de sauvegarde (comme un gros c** que j'suis :roll:)). Please help !!!

Je précise que si on décide par la suite d'enregistrer le fichier en acceptant la perte du vba, la taille du fichier diminue grandement, ce qui à mon sens montre qu'il y a bien encore le code quelque part...

Par avance merci à tous ceux qui vont se pencher un peu sur mon problème.

:salut:

dans ton onglet FeuilVBA, je tombe sur

Citation:

---

DES INSERTIONS DE LIGNE(S) OU COLONNE(S) DANS CET ONGLET PEUVENT TOUT FAIRE PLANTER !!!!

---

ca pose potentiellement déjà un problème de conception de ton classeur, non ?

Dans ta PJ, on n'a aucun code VBA de disponible, le fichier faisant 112Ko, donc rien de bien gros

Bonjour,
Est-ce que tu veux dire que tu as fais les réparations proposées sans dupliquer ton ficher ? Là, tu es mal. Sinon, mets le fichier non "réparé" en pièce jointe.

Effectivement, 'ai pas été malin sur ce coup, ci-joint le fichier à problème.

Concernant le message d'alerte sur l'onglet FeuilVBA, c'est simplement un bref rappel pour ma pomme. En fait cette feuille sera plus tard rendue inaccessible et pour l'instant j'ai un bout de code qui fait référence à des cellules de la feuille et non à des noms de cellules ou de zone. C'est donc juste pour me rappeler ceci.

Merci.

En ouvrant le fichier avec OpenOffice, je récupère ce qui suit, en espérant que ça te concerne... Par contre, si on voit les userforms en ouvrant le fichier avec OO et en regardant du côté des macros, je n'ai pas trouvé comment les exporter. Tu peux faire la même manip pour les voir et les refaire.

Code:

---

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 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813

Rem Attribute VBA_ModuleType=VBAModule Sub Alertes Rem Sub Alerte0() Rem MsgBox "La liste des valeurs est restreinte aux propositions suivantes :" & Chr(10) & _ Rem " - Par proportion (plancher)" & Chr(10) & _ Rem " - Par proportion (plafond)" & Chr(10) & _ Rem " - Rang (plancher)" & Chr(10) & _ Rem " - Rang (plafond)" & Chr(10) & _ Rem " - Appréciation" Rem Application.EnableEvents = True Rem End Rem End Sub   Rem Attribute VBA_ModuleType=VBADocumentModule Sub Feuil10 Rem Private Sub Worksheet_Change(ByVal Target As Range) Rem Rem If Target.Count > 1 Then Exit Sub Rem 'permet de sortir de la procédure si plus d'une cellule est sélectionnée Rem '(sinon la suite de la macro renvoie un message d'erreur) Rem Rem If Target.Row = ActiveSheet.Range("Entre_dans_scoring").Row + 1 Then Rem If Target.Column >= ActiveSheet.Range("Entre_dans_scoring").Column Then Rem If Target.Column <= ActiveSheet.Range("Entre_dans_scoring").Column + ActiveSheet.Range("Entre_dans_scoring") Then Rem Rem End If Rem End If Rem End If Rem Rem If Target.Column = Range("Methode").Column Then Call Scoring Rem Rem End Sub Rem End Sub   Rem Attribute VBA_ModuleType=VBADocumentModule Sub Feuil2 Rem Dim Cible As Variant Rem Rem Private Sub Worksheet_SelectionChange(ByVal Target As Range) Rem Rem If Target.Count > 1 Then Exit Sub Rem 'permet de sortir de la procédure si plus d'une cellule est sélectionnée Rem '(sinon la suite de la macro renvoie un message d'erreur) Rem Rem If Target.Row >= ActiveSheet.Range("Entre_dans_scoring").Row + 3 And Target.Row <= ActiveSheet.Range("Fin").Row Then Rem If Target.Column >= ActiveSheet.Range("Entre_dans_scoring").Column Then Rem If Target.Column < ActiveSheet.Range("Entre_dans_scoring").Column + ActiveSheet.Range("Nb_ass") Then Rem Cible = Target.Value Rem Cible_Row = Target.Row Rem End If Rem End If Rem End If Rem End Sub Rem Rem Private Sub Worksheet_Change(ByVal Target As Range) Rem Rem Application.EnableEvents = False Rem Rem If Target.Count > 1 Then Exit Sub Rem 'permet de sortir de la procédure si plus d'une cellule est sélectionnée Rem '(sinon la suite de la macro renvoie un message d'erreur) Rem Rem Cible_Row = Target.Row Rem Cible_Col = Target.Column Rem Rem 'Actions sur la colonne Méthode si on modifie les notes : Rem If Target.Row >= ActiveSheet.Range("Entre_dans_scoring").Row + 3 And Target.Row <= ActiveSheet.Range("Fin").Row Then Rem If Target.Column >= ActiveSheet.Range("Entre_dans_scoring").Column Then Rem If Target.Column < ActiveSheet.Range("Entre_dans_scoring").Column + ActiveSheet.Range("Nb_ass") Then Rem Cible_Row = Target.Row Rem If Target.Value <> Cible And Cells(Cible_Row, Range("Methode").Column) <> "" Then Rem Cells(Cible_Row, Range("Methode").Column) = "Appréciation" Rem Application.EnableEvents = True Rem End Rem End If Rem If Target.Value = "" And Cible = 0 And Cells(Cible_Row, Range("Methode").Column) <> "" Then Rem Cells(Cible_Row, Range("Methode").Column) = "Appréciation" Rem Application.EnableEvents = True Rem End Rem End If Rem If Target.Value = 0 And Cible = "" And Cells(Cible_Row, Range("Methode").Column) <> "" Then Rem Cells(Cible_Row, Range("Methode").Column) = "Appréciation" Rem Application.EnableEvents = True Rem End Rem End If Rem End If Rem End If Rem End If Rem Rem 'MAJ des calculs si on valide l'entrée dans le scoring d'un autre candidat Rem If Target.Row = ActiveSheet.Range("Entre_dans_scoring").Row + 1 Then Rem If Target.Column >= ActiveSheet.Range("Entre_dans_scoring").Column Then Rem If Target.Column < ActiveSheet.Range("Entre_dans_scoring").Column + ActiveSheet.Range("Nb_ass") Then Rem If Target.Value = "Oui" Then Call Calc_methodes Rem End If Rem End If Rem End If Rem Rem 'Calcul des scores pour une méthode choisie Rem If Target.Column = Range("Methode").Column And Target.Row <= ActiveSheet.Range("Fin").Row Then Call Scoring Rem Rem Application.EnableEvents = True Rem End Sub Rem End Sub   Rem Attribute VBA_ModuleType=VBADocumentModule Sub Feuil3 Rem Private Sub Worksheet_Change(ByVal Target As Range) Rem Rem If Target.Count > 1 Then Exit Sub Rem 'permet de sortir de la procédure si plus d'une cellule est sélectionnée Rem '(sinon la suite de la macro renvoie un message d'erreur) Rem Rem Dim Plage As Range Rem Set Plage = Range("Codes_associes") Rem Rem If Not (Application.Intersect(Target, Plage) Is Nothing) Then Rem If Target.Value = "" Then Target.Value = 0 Rem If IsNumeric(Target.Value) Then Rem Nb_ass = Range("Nb_ass") Rem lig = Target.Row Rem col_start = Range("Ass1").Column Rem Rem Dim TableauLigCodes() As Integer 'on y mettra pour chaque code associé la ligne de la zone Codes où se situe les valeurs cibles Rem ReDim TableauLigCodes(Range("Nb_agreg").Value - 1) Rem Rem Dim TableauCoeffs() As Integer 'on y mettra les différents coefficients associés aux codes Rem ReDim TableauCoeffs(Range("Nb_agreg").Value - 1) Rem Rem Dim TableauNotes() As Integer 'on y mettra les différentes notes associés aux codes Rem ReDim TableauNotes(Range("Nb_agreg").Value - 1) Rem Rem Rem For i = 0 To Range("Nb_ass").Value - 1 Rem For j = 0 To Range("Nb_agreg").Value - 1 Rem If Cells(lig, Range("Nb_agreg").Column + j) > 0 Then Rem TableauLigCodes(j) = Application.WorksheetFunction.Match(Cells(lig, Range("Nb_agreg").Column + j), Range("Codes"), 0) Rem TableauCoeffs(j) = Range("Nb_ass").Offset(TableauLigCodes(j) - 1, Nb_ass + 1) Rem TableauNotes(j) = Range("Nb_ass").Offset(TableauLigCodes(j) - 1, i + 1) Rem Else Rem TableauLigCodes(j) = 0 Rem TableauCoeffs(j) = 0 Rem TableauNotes(j) = 0 Rem End If Rem Next j Rem Rem 'calcul de la note pondérée : Rem sumprod = 0 Rem For k = 0 To Range("Nb_agreg").Value - 1 Rem sumprod = sumprod + TableauNotes(k) * TableauCoeffs(k) Rem Next k Rem sumcoef = Application.WorksheetFunction.Sum(TableauCoeffs()) Rem Rem If sumcoef = 0 Then Rem Cells(lig, col_start + i) = 0 Rem Else Rem Cells(lig, col_start + i) = sumprod / sumcoef Rem End If Rem Next i Rem End If Rem End If Rem Rem End Sub Rem End Sub   Rem Attribute VBA_ModuleType=VBADocumentModule Sub Feuil4 Rem Private Sub Worksheet_Change(ByVal Target As Range) Rem Rem If Target.Count > 1 Then Exit Sub Rem 'permet de sortir de la procédure si plus d'une cellule est sélectionnée Rem '(sinon la suite de la macro renvoie un message d'erreur) Rem Rem If Target.Row = ActiveSheet.Range("Entre_dans_scoring").Row + 1 Then Rem If Target.Column >= ActiveSheet.Range("Entre_dans_scoring").Column Then Rem If Target.Column <= ActiveSheet.Range("Entre_dans_scoring").Column + ActiveSheet.Range("Entre_dans_scoring") Then Rem Rem End If Rem End If Rem End If Rem Rem If Target.Column = Range("Methode").Column Then Call Scoring Rem Rem End Sub Rem End Sub Rem Rem Sub Alerte1() Rem MsgBox "Les méthodes de notation" & Chr(10) & _ Rem " - Par proportion (plancher)" & Chr(10) & _ Rem " - Par proportion (plafond)" & Chr(10) & _ Rem " - Rang (plancher)" & Chr(10) & _ Rem " - Rang (plafond)" & Chr(10) & _ Rem "sont utilisables uniquement dans le cas de valeurs numériques." & Chr(10) & Chr(10) & _ Rem "(Pour rappel : le vide ' ' n'est pas une valeur numérique.)" Rem Application.EnableEvents = True Rem End Rem End Sub Rem Rem Sub Alerte2() Rem MsgBox "Les méthodes de notation" & Chr(10) & _ Rem " - Par proportion (plancher)" & Chr(10) & _ Rem " - Par proportion (plafond)" & Chr(10) & _ Rem "sont utilisables uniquement dans le cas où les réponses de valeurs numériques sont de même signe." Rem Application.EnableEvents = True Rem End Rem End Sub Rem Rem Sub Alerte3() Rem MsgBox "La méthode de notation" & Chr(10) & _ Rem " - Par proportion (plafond)" & Chr(10) & _ Rem "n'est pas utilisable dans le cas où les réponses sont des valeurs négatives avec au moins une valeur nulle." Rem Application.EnableEvents = True Rem End Rem End Sub Rem Rem Sub Alerte4() Rem MsgBox "La méthode de notation" & Chr(10) & _ Rem " - Par proportion (plancher)" & Chr(10) & _ Rem "n'est pas utilisable dans le cas où les réponses sont des valeurs positives avec au moins une valeur nulle." Rem Application.EnableEvents = True Rem End Rem End Sub Rem Rem End Sub   Rem Attribute VBA_ModuleType=VBADocumentModule Sub Feuil1 Rem Private Sub CommandButton1_Click() Rem UserForm1.Show Rem End Sub Rem Rem Private Sub Worksheet_Change(ByVal Target As Range) Rem Rem If Target.Count > 1 Then Exit Sub Rem 'permet de sortir de la procédure si plus d'une cellule est sélectionnée Rem '(sinon la suite de la macro renvoie un message d'erreur) Rem Rem Dim Plage As Range Rem Set Plage = Range("Codes_associes") Rem Rem If Not (Application.Intersect(Target, Plage) Is Nothing) Then Rem If Target.Value = "" Then Target.Value = 0 Rem If IsNumeric(Target.Value) Then Rem Nb_ass = Range("Nb_ass") Rem lig = Target.Row Rem col_start = Range("Ass1").Column Rem Rem Dim TableauLigCodes() As Integer 'on y mettra pour chaque code associé la ligne de la zone Codes où se situe les valeurs cibles Rem ReDim TableauLigCodes(Range("Nb_agreg").Value - 1) Rem Rem Dim TableauCoeffs() As Integer 'on y mettra les différents coefficients associés aux codes Rem ReDim TableauCoeffs(Range("Nb_agreg").Value - 1) Rem Rem Dim TableauNotes() As Integer 'on y mettra les différentes notes associés aux codes Rem ReDim TableauNotes(Range("Nb_agreg").Value - 1) Rem Rem Rem For i = 0 To Range("Nb_ass").Value - 1 Rem For j = 0 To Range("Nb_agreg").Value - 1 Rem If Cells(lig, Range("Nb_agreg").Column + j) > 0 Then Rem TableauLigCodes(j) = Application.WorksheetFunction.Match(Cells(lig, Range("Nb_agreg").Column + j), Range("Codes"), 0) Rem TableauCoeffs(j) = Range("Nb_ass").Offset(TableauLigCodes(j) - 1, Nb_ass + 1) Rem TableauNotes(j) = Range("Nb_ass").Offset(TableauLigCodes(j) - 1, i + 1) Rem Else Rem TableauLigCodes(j) = 0 Rem TableauCoeffs(j) = 0 Rem TableauNotes(j) = 0 Rem End If Rem Next j Rem Rem 'calcul de la note pondérée : Rem sumprod = 0 Rem For k = 0 To Range("Nb_agreg").Value - 1 Rem sumprod = sumprod + TableauNotes(k) * TableauCoeffs(k) Rem Next k Rem sumcoef = Application.WorksheetFunction.Sum(TableauCoeffs()) Rem Rem If sumcoef = 0 Then Rem Cells(lig, col_start + i) = 0 Rem Else Rem Cells(lig, col_start + i) = sumprod / sumcoef Rem End If Rem Next i Rem End If Rem End If Rem Rem End Sub Rem End Sub   Rem Attribute VBA_ModuleType=VBADocumentModule Sub Feuil5 Rem Private Sub Worksheet_Change(ByVal Target As Range) Rem Rem If Target.Count > 1 Then Exit Sub Rem 'permet de sortir de la procédure si plus d'une cellule est sélectionnée Rem '(sinon la suite de la macro renvoie un message d'erreur) Rem Rem If Target.Row = ActiveSheet.Range("Entre_dans_scoring").Row + 1 Then Rem If Target.Column >= ActiveSheet.Range("Entre_dans_scoring").Column Then Rem If Target.Column <= ActiveSheet.Range("Entre_dans_scoring").Column + ActiveSheet.Range("Entre_dans_scoring") Then Rem Rem End If Rem End If Rem End If Rem Rem If Target.Column = Range("Methode").Column Then Call Scoring Rem Rem End Sub Rem End Sub   Rem Attribute VBA_ModuleType=VBADocumentModule Sub Feuil6 Rem Private Sub Worksheet_Change(ByVal Target As Range) Rem Rem If Target.Count > 1 Then Exit Sub Rem 'permet de sortir de la procédure si plus d'une cellule est sélectionnée Rem '(sinon la suite de la macro renvoie un message d'erreur) Rem Rem If Target.Row = ActiveSheet.Range("Entre_dans_scoring").Row + 1 Then Rem If Target.Column >= ActiveSheet.Range("Entre_dans_scoring").Column Then Rem If Target.Column <= ActiveSheet.Range("Entre_dans_scoring").Column + ActiveSheet.Range("Entre_dans_scoring") Then Rem Rem End If Rem End If Rem End If Rem Rem If Target.Column = Range("Methode").Column Then Call Scoring Rem Rem End Sub Rem End Sub   Rem Attribute VBA_ModuleType=VBADocumentModule Sub Feuil8 Rem Private Sub Worksheet_Change(ByVal Target As Range) Rem Rem If Target.Count > 1 Then Exit Sub Rem 'permet de sortir de la procédure si plus d'une cellule est sélectionnée Rem '(sinon la suite de la macro renvoie un message d'erreur) Rem Rem If Target.Row = ActiveSheet.Range("Entre_dans_scoring").Row + 1 Then Rem If Target.Column >= ActiveSheet.Range("Entre_dans_scoring").Column Then Rem If Target.Column <= ActiveSheet.Range("Entre_dans_scoring").Column + ActiveSheet.Range("Entre_dans_scoring") Then Rem Rem End If Rem End If Rem End If Rem Rem If Target.Column = Range("Methode").Column Then Call Scoring Rem Rem End Sub Rem End Sub   Rem Attribute VBA_ModuleType=VBADocumentModule Sub Feuil9 Rem Private Sub Worksheet_Change(ByVal Target As Range) Rem Rem If Target.Count > 1 Then Exit Sub Rem 'permet de sortir de la procédure si plus d'une cellule est sélectionnée Rem '(sinon la suite de la macro renvoie un message d'erreur) Rem Rem If Target.Row = ActiveSheet.Range("Entre_dans_scoring").Row + 1 Then Rem If Target.Column >= ActiveSheet.Range("Entre_dans_scoring").Column Then Rem If Target.Column <= ActiveSheet.Range("Entre_dans_scoring").Column + ActiveSheet.Range("Entre_dans_scoring") Then Rem Rem End If Rem End If Rem End If Rem Rem If Target.Column = Range("Methode").Column Then Call Scoring Rem Rem End Sub Rem End Sub   Rem Attribute VBA_ModuleType=VBAModule Sub Fonctions Rem Function copie_colle_Tout(lig_deb As Integer, lig_fin As Integer, col_deb As Integer, col_fin As Integer, lig_cible As Integer, col_cible As Integer) Rem Rem ActiveSheet.Range(Cells(lig_deb, col_deb), Cells(lig_fin, col_fin)).Copy Rem ActiveSheet.Cells(lig_cible, col_cible).PasteSpecial Paste:=xlPasteAll Rem Application.CutCopyMode = False Rem Rem End Function Rem Rem End Sub   Rem Attribute VBA_ModuleType=VBAModule Sub Mises_en_forme Rem Dim lig_deb As Integer, lig_fin As Integer, col_deb As Integer, col_fin As Integer, lig_cible As Integer, col_cible As Integer Rem Rem Sub MEF_Scoring1() 'Mise en forme du tableau de synthèse dans l'onglet Scoring Rem Rem lig_deb = Range("Ass1").Row Rem col_deb = Range("Ass1").Column Rem lig_fin = Range("Fin1").Row Rem col_fin = col_deb Rem lig_cible = lig_deb Rem Rem For i = 1 To Nb_candidatures - Range("Nb_ass") Rem col_cible = col_deb + Range("Nb_ass") + i - 1 Rem Action = copie_colle_Tout(lig_deb, lig_fin, col_deb, col_fin, lig_cible, col_cible) Rem Rem Range(Cells(lig_deb + 2, col_cible), Cells(lig_fin, col_cible)).ClearContents Rem Rem For j = 1 To lig_fin - (lig_deb + 2) Rem If InStr(Cells(lig_deb + 1 + j, col_deb - 2), "Total") > 0 Then _ Rem Action = copie_colle_Tout(lig_deb + 1 + j, lig_deb + 1 + j, col_deb, col_deb, lig_deb + 1 + j, col_cible) Rem Next j Rem Next i Rem Rem End Sub Rem Rem Sub MEF_Scoring2() Rem Rem For j = 1 To Nb_candidatures - Range("Nb_ass") Rem lig_deb = Range("Nb_ass").Row Rem lig_fin = lig_deb Rem col_deb = Range("Nb_ass").Column + 1 Rem col_fin = col_deb Rem lig_cible = lig_deb Rem col_cible = col_deb + Range("Nb_ass") + j - 1 Rem Action = copie_colle_Tout(lig_deb, lig_fin, col_deb, col_fin, lig_cible, col_cible) Rem Next j Rem Rem End Sub Rem Sub MEF_Entrent_dans_le_scoring() Rem Rem lig = Range("Entre_dans_scoring").Row Rem col = Range("Entre_dans_scoring").Column Rem Range(Cells(lig, col), Cells(lig, col + Range("Nb_ass") - 1)).Merge Rem lig2 = Range("Methode").Row Rem Range(Cells(lig2, col), Cells(lig2, col + Range("Nb_ass") - 1)).Merge Rem Rem lig_deb = Range("Entre_dans_scoring").Row + 1 Rem lig_fin = lig_deb Rem col_deb = col Rem col_fin = col_deb Rem lig_cible = lig_deb Rem col_cible = col_deb + Worksheets(Feuille_Scoring).Range("Nb_ass") + j - 1 Rem Action = copie_colle_Tout(lig_deb, lig_fin, col_deb, col_fin, lig_cible, col_cible) Rem Rem lig3 = Range("Entre_dans_scoring").Row + 1 Rem For i = 1 To Nb_candidatures - Worksheets(Feuille_Scoring).Range("Nb_ass") Rem col3 = Range("Entre_dans_scoring").Column + Worksheets(Feuille_Scoring).Range("Nb_ass") - 1 + i Rem Cells(lig3, col3).Select Rem Call Bordures_1 Rem Next i Rem Rem End Sub Rem Rem Sub Bordures_1() Rem Range("G2").Select Rem With Selection.Borders(xlEdgeLeft) Rem .LineStyle = xlContinuous Rem .Weight = xlThin Rem .ColorIndex = xlAutomatic Rem End With Rem With Selection.Borders(xlEdgeTop) Rem .LineStyle = xlContinuous Rem .Weight = xlThin Rem .ColorIndex = xlAutomatic Rem End With Rem End Sub Rem End Sub   Rem Attribute VBA_ModuleType=VBAModule Sub Nbr_Candidatures Rem Sub Ajout_Col() Rem Rem Dim Plage As Range Rem Dim Nm As Name Rem Dim lig_deb As Integer, lig_fin As Integer, col_deb As Integer, col_fin As Integer, lig_cible As Integer, col_cible As Integer Rem Rem On Error Resume Next Rem Rem 'Rajout des colonnes dans le tableau récapitulatif de l'onglet Scoring Rem col_deb = Range("Nb_ass").Column + Range("Nb_ass") + 1 Rem col_fin = col_deb + Nb_candidatures - Range("Nb_ass") - 1 Rem Range(Cells(60000, col_deb), Cells(60000, col_fin)).Select Rem Selection.EntireColumn.Insert Shift:=xlToRight Rem Rem For i = 1 To Worksheets.Count Rem For Each Nm In ThisWorkbook.Names 'Rajout des colonnes dans chaque onglet où apparait le nom de cellule "Ass1" Rem Set Plage = Nm.RefersToRange Rem Rem If Not Plage Is Nothing Then Rem 'Vérifie si le nom appartient à la feuille Rem If Worksheets(i).Name = Plage.Worksheet.Name Then Rem If InStr(Nm.Name, "Ass1") > 0 Then Rem Worksheets(i).Activate Rem Rem col_deb = Worksheets(i).Range("Ass1").Column + Worksheets(i).Range("Nb_ass") Rem col_fin = col_deb + Nb_candidatures - Range("Nb_ass") - 1 Rem Worksheets(i).Range(Cells(60000, col_deb), Cells(60000, col_fin)).Select Rem Selection.EntireColumn.Insert Shift:=xlToRight Rem Rem Worksheets(i).Range("A1").Select Rem End If Rem If InStr(Nm.Name, "Methode") > 0 Then Rem Worksheets(i).Activate Rem Rem col_deb = Worksheets(i).Range("Methode").Column Rem col_fin = col_deb + Nb_candidatures - Worksheets(Feuille_Scoring).Range("Nb_ass") - 1 Rem Worksheets(i).Range(Cells(60000, col_deb), Cells(60000, col_fin)).Select Rem Selection.EntireColumn.Insert Shift:=xlToRight Rem Rem Call MEF_Entrent_dans_le_scoring Rem Worksheets(i).Range("A1").Select Rem End If Rem End If Rem End If Rem Rem Set Plage = Nothing Rem Next Nm Rem Rem For Each Nm In ThisWorkbook.Names 'Rajout des noms des candidats" Rem Set Plage = Nm.RefersToRange Rem Rem If Not Plage Is Nothing Then Rem 'Vérifie si le nom appartient à la feuille Rem If Worksheets(i).Name = Plage.Worksheet.Name Then Rem If InStr(Nm.Name, "Entre_dans_scoring") > 0 Then Rem Worksheets(i).Activate Rem For j = 1 To Nb_candidatures - Worksheets(Feuille_Scoring).Range("Nb_ass") Rem lig_deb = Worksheets(i).Range("Ass1").Row Rem lig_fin = lig_deb Rem col_deb = Worksheets(i).Range("Ass1").Column Rem col_fin = col_deb Rem lig_cible = lig_deb Rem col_cible = col_deb + Worksheets(Feuille_Scoring).Range("Nb_ass") + j - 1 Rem Action = copie_colle_Tout(lig_deb, lig_fin, col_deb, col_fin, lig_cible, col_cible) Rem Next j Rem Worksheets(i).Range("A1").Select Rem End If Rem End If Rem End If Rem Rem Set Plage = Nothing Rem Next Nm Rem Next i Rem Rem Worksheets(Feuille_Scoring).Activate Rem Rem End Sub Rem Rem Sub Suppr_Col() Rem Rem End Sub Rem End Sub   Rem Attribute VBA_ModuleType=VBAModule Sub Scoring_Onglets Rem Sub Scoring() Rem Rem Select Case Cells(Cible_Row, Cible_Col).Value Rem Case "Rang (plafond)" Rem Case "Rang (plancher)" Rem Case "Par proportion (plafond)" Rem Case "Par proportion (plancher)" Rem Case "Appréciation" Rem Application.EnableEvents = True Rem End Rem Case "" Rem Application.EnableEvents = True Rem End Rem Case Else Rem Cells(Cible_Row, Cible_Col).ClearContents Rem Call Alerte0 Rem End Select Rem Rem Application.EnableEvents = False Rem Rem Nb_ass = ActiveSheet.Range("Nb_ass").Value 'nombre de candidatures (colonnes) possibles à évaluer dans la feuille Rem Max_points = 5 Rem Dim Plage1, Plage2 As Range Rem Dim Arret_tri As Integer Rem Dim Cible As Variant Rem Rem col = ActiveSheet.Range("Entre_dans_scoring").Column 'colonne de la note du 1er candidat Rem lig = ActiveSheet.Range("Entre_dans_scoring").Row + 1 'ligne du fichier qui dit si on note le candidat Rem lig_active = Cible_Row Rem Rem nb = ActiveSheet.Range("Entre_dans_scoring").Value Rem Rem Dim TableauCol() As Integer 'on définit le vecteur de: numéro de colonnes qui seront affiliées d'une note Rem ReDim TableauCol(nb - 1) Rem Rem Dim TableauColAss() As Integer 'on définit le vecteur de: colonnes qui sont les colonnes des réponses à noter Rem ReDim TableauColAss(nb - 1) Rem Rem Dim TableauValAss() As Variant 'on définit le vecteur de: réponses qui sont dans les colonnes des réponses à noter Rem ReDim TableauValAss(nb - 1) Rem Rem Dim TableauValAssTrié() As Variant 'on définit le vecteur de: réponses qui sont dans les colonnes des réponses à noter et qui seront triées dans l'ordre croissant Rem ReDim TableauValAssTrié(nb - 1) Rem Rem j = -1 Rem k = 0 Rem inc = 0 Rem Rem Sheets("FeuilVBA").Range("A2:A6").ClearContents Rem Sheets("FeuilVBA").Range("B8") = nb Rem Rem For i = col To col * 10 'i commence à la colonne note du 1er candidat Rem If Cells(lig, i) = "Oui" Then Rem inc = inc + 1 Rem j = j + 1 Rem TableauCol(j) = Cells(lig, i).Column 'on remplit nos vecteurs qu'on a défini au début Rem TableauColAss(j) = Cells(lig, i - Nb_ass).Column Rem TableauValAss(j) = Cells(lig_active, TableauColAss(j)).Value Rem Sheets("FeuilVBA").Range("A" & 2 + k) = TableauValAss(j) Rem k = k + 1 Rem TableauValAssTrié(j) = TableauValAss(j) Rem Rem If TableauValAss(j) = "" Or Not (IsNumeric(TableauValAss(j))) Then Rem Call Alerte1 Rem End If Rem Rem Max = Application.WorksheetFunction.Max(TableauValAss()) Rem 'If Max = TableauValAss(j) Then Col_max = TableauColAss(j) 'on définit la colonne qui contient la valeur max Rem Rem Min = Application.WorksheetFunction.Min(TableauValAss()) Rem 'If Min = TableauValAss(j) Then Col_min = TableauColAss(j) 'on définit la colonne qui contient la valeur min Rem Rem If inc = nb Then i = col * 10 Rem End If Rem Next i Rem inc = 0 Rem i = 0 Rem k = 0 Rem Rem Do 'tri décroissant Rem Arret_tri = 0 Rem For i = 0 To UBound(TableauValAssTrié) - 1 Rem If TableauValAssTrié(i) < TableauValAssTrié(i + 1) Then Rem Cible = TableauValAssTrié(i) Rem TableauValAssTrié(i) = TableauValAssTrié(i + 1) Rem TableauValAssTrié(i + 1) = Cible Rem Arret_tri = 1 Rem End If Rem Next i Rem Loop While Arret_tri = 1 Rem i = 0 Rem Rem 'on appele Plage1 la zone du tableau trié Rem Set Plage1 = Sheets("FeuilVBA").Range("B17:F17") Rem Plage1.ClearContents Rem For i = 0 To nb - 1 Rem Sheets("FeuilVBA").Cells(17, 2 + i) = TableauValAssTrié(i) Rem Next i Rem i = 0 Rem Rem 'on appele Plage2 la zone de score de la ligne active Rem Set Plage2 = ActiveSheet.Range(Cells(lig_active, col), Cells(lig_active, Cells(Cible_Row, Cible_Col).Column - 1)) Rem Rem Select Case Cells(Cible_Row, Cible_Col).Value Rem Rem Case "Rang (plafond)" Rem Plage2.ClearContents Rem For i = 0 To nb - 1 Rem Cells(lig_active, TableauCol(i)) = Sheets("FeuilVBA").Range("B" & i + 2) Rem Next i Rem Rem Case "Rang (plancher)" Rem Plage2.ClearContents Rem For i = 0 To nb - 1 Rem Cells(lig_active, TableauCol(i)) = Sheets("FeuilVBA").Range("C" & i + 2) Rem Next i Rem Rem Case "Par proportion (plafond)" 'correspond à une règle de 3 Rem Plage2.ClearContents Rem If Sheets("FeuilVBA").Range("Alerte") = 5 Then Rem Call Alerte2 Rem End If Rem If Sheets("FeuilVBA").Range("Alerte") = 4 Then Rem Call Alerte3 Rem End If Rem For i = 0 To nb - 1 Rem Cells(lig_active, TableauCol(i)) = Sheets("FeuilVBA").Range("D" & i + 2) Rem Next i Rem Rem Case "Par proportion (plancher)" Rem Plage2.ClearContents Rem If Sheets("FeuilVBA").Range("Alerte") = 5 Then Rem Call Alerte2 Rem End If Rem If Sheets("FeuilVBA").Range("Alerte") = 2 Then Rem Call Alerte4 Rem End If Rem For i = 0 To nb - 1 Rem Cells(lig_active, TableauCol(i)) = Sheets("FeuilVBA").Range("E" & i + 2) Rem Next i Rem Rem End Select Rem i = 0 Rem j = 0 Rem l = 0 Rem Rem End Sub Rem Rem Sub Calc_methodes() Rem Rem For i = 1 To Range("Fin").Row - Range("Methode").Row Rem If Range("Methode").Offset(i, 0) <> "" And Range("Methode").Offset(i, 0) <> "Appréciation" Then Rem Cible_Row = Range("Methode").Offset(i, 0).Row Rem Cible_Col = Range("Methode").Column Rem Call Scoring Rem End If Rem Next i Rem Rem End Sub Rem End Sub   Rem Attribute VBA_ModuleType=VBAFormModule Sub UserForm1 Rem Rem Private Sub UserForm_Initialize() Rem OptionButton1 = True Rem With SpinButton1 Rem .Min = 1 'Valeur mini Rem .Max = 5 'Valeur maxi Rem 'Spécifie le déplacement se produisant lorsque l'utilisateur clique sur Rem 'les flèches de défilement dans le contrôle SpinButton Rem '(La valeur par défaut = 1) Rem '.SmallChange = 1 Rem End With Rem TextBox1 = 1 Rem End Sub Rem Rem Private Sub SpinButton1_Change() Rem TextBox1 = SpinButton1.Value Rem End Sub Rem Rem Private Sub CommandButton1_Click() Rem Unload UserForm1 Rem Nb_candidatures = TextBox1.Value Rem UserForm2.Show Rem End Sub Rem End Sub   Rem Attribute VBA_ModuleType=VBAFormModule Sub UserForm2 Rem Private Sub UserForm_Activate() Rem Rem For i = 1 To Nb_candidatures Rem With UserForm2.Controls("Frame" & i) Rem .Top = 12 + 48 * (i - 1) Rem End With Rem Next i Rem For i = 1 To 2 Rem UserForm2.Controls("CommandButton" & i).Top = 12 + 48 * Nb_candidatures Rem Next i Rem UserForm2.Height = 12 + 48 * (Nb_candidatures + 1) Rem Rem If Nb_candidatures < 5 Then Rem For i = Nb_candidatures + 1 To 5 Rem With UserForm2.Controls("Frame" & i) Rem .Top = 12 + 48 * i Rem End With Rem UserForm2.Controls("TextBox" & i).Value = "" Rem Next i Rem End If Rem End Sub Rem Rem Private Sub CommandButton2_Click() Rem UserForm2.Hide Rem UserForm1.Show Rem End Sub Rem Rem Private Sub CommandButton1_Click() Rem Rem Feuille_Scoring = ActiveSheet.Name Rem Rem If Nb_candidatures > Range("Nb_ass") Then Rem Call Ajout_Col Rem Call MEF_Scoring1 Rem Call MEF_Scoring2 Rem Else Rem Call Suppr_Col Rem End If Rem Rem For i = 1 To Nb_candidatures Rem Range("Ass1").Offset(0, i - 1) = UserForm2.Controls("TextBox" & i).Value Rem Next i Rem Rem Range("Nb_ass") = Nb_candidatures Rem Unload UserForm2 Rem End Sub Rem End Sub   Rem Attribute VBA_ModuleType=VBAModule Sub Variables_Publiques Rem Public Cible_Row As Integer Rem Public Cible_Col As Integer Rem Public Nb_candidatures As Integer Rem Public Feuille_Scoring As String Rem End Sub

---

Tu déchires !!!!!!!!! :ccool:

Tu as fait une manip spéciale avec OO ? because j'avais essayé sans succès.

(tant pis pour les 2 pov userforms, ce qui m'importait surtout c'était de récupérer les 800 lignes de code pour pas me les retaper :mrgreen:)

Non, en fait, j'ai cherché à regarder le code (avec le fichier non "réparé").

Salut, il n'y a qu'à regarder dans http://silkyroad.developpez.com/Exce...ursEndommages/

Bonjour,
Je ne sais pas si c'est une question de version ou de différence avec OpenOffice, mais avec LibreOffice, les lignes de code ne sont pas toutes mises en commentaire (REM) :).
Exemple :

Code:

---

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

Rem Attribute VBA_ModuleType=VBAFormModule Option VBASupport 1 Private Sub UserForm_Activate()   For i = 1 To Nb_candidatures With UserForm2.Controls("Frame" & i) .Top = 12 + 48 * (i - 1) End With Next i For i = 1 To 2 UserForm2.Controls("CommandButton" & i).Top = 12 + 48 * Nb_candidatures Next i UserForm2.Height = 12 + 48 * (Nb_candidatures + 1)   If Nb_candidatures < 5 Then For i = Nb_candidatures + 1 To 5 With UserForm2.Controls("Frame" & i) .Top = 12 + 48 * i End With UserForm2.Controls("TextBox" & i).Value = "" Next i End If End Sub   Private Sub CommandButton2_Click() UserForm2.Hide UserForm1.Show End Sub   Private Sub CommandButton1_Click()   Feuille_Scoring = ActiveSheet.Name   If Nb_candidatures > Range("Nb_ass") Then Call Ajout_Col Call MEF_Scoring1 Call MEF_Scoring2 Else Call Suppr_Col End If   For i = 1 To Nb_candidatures Range("Ass1").Offset(0, i - 1) = UserForm2.Controls("TextBox" & i).Value Next i   Range("Nb_ass") = Nb_candidatures Unload UserForm2 End Sub

---