Discussion :

[Patate3181]

Bonjour à tous,

Je me permets de venir vous solliciter aujourd'hui pour réaliser une optimisation si c'est possible. (Je n'ai pas réussi à trouver d'équivalent sur le forum)

J'ai un code qui fonctionne et qui réalise ce que je souhaites cependant il est extrêmement lent et pose quelques problématiques sur le remplissage.

Je vous présente l'objectif :

J'ai une équipe de 150 personnes (Pas tous très à l'aise avec l'outil informatique) qui doivent remplir un rapport sur Excel. Ce rapport doit pouvoir :

1. encaisser des copier coller de tout type, de toute provenance, et de toute forme et le mettre dans un formalisme convenable. Bien évidemment, la cellule doit pouvoir être re modifiable par la suite.
2. La cellule doit s'adapter au contenu du coup je n'ai pas utilisé la fonction fusionner mais "Centrer sur plusieurs colonnes" cependant ça force à écrire sur la cellule de gauche ce qui ergonomiquement parlant n'est pas ultra parfait.

Je suis donc ouvert à toutes suggestions d'améliorations mon but est d'apprendre et de m'améliorer j'ai réalisé ce code en farfouillant sur internet et en adaptant donc il n'est pas parfait merci de votre indulgence et au plaisir de vous lire

PS: J'ai oublié de préciser mais sur cette feuille le code que vous trouverez ci dessous existe en 13 fois. Je l'ai donc dupliqué à chaque fois, je n'ai pas réussi à les fusionner

Code pour une cellule :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Set KeyCells = Range("D7:H7")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Societe_Auditee.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("D7:H7").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Rows.AutoFit
    Ws_Plan.Range("D7").Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If

Au besoin je pourrai joindre une partie du fichier en attendant, je peux vous proposer une image afin que vous ayez une visualisation esthétique

Merci et belle journée !