XL 2013 Fonction TRANSPOSE avec prise en compte des mises en forme conditionnelles

[Aile2poulet]

Bonjour à tous,

Je suis qualiticien et je me permets de vous exposer mon problème (j'y ai passé l'après-midi...)
J'ai un fichier Excel avec 2 onglets:
- le premier est complété manuellement (case pointillées rouge) pour le nombre de décimales, les valeurs (de 1 à 10) et le CV. Le reste est calculé automatiquement.
- le second est rempli également automatiquement afin d'imprimer un rapport.

Mon problème est le suivant:
Lorsque la fonction TRANSPOSE se mets en place, le nombre de décimales ne correspond pas au premier onglet.
Peut-on transposer des mises en forme conditionnelles?

Pour être plus explicite, je vous ai mis en pièce jointe le fichier.
En espérant que quelqu'un ait une solution.

Un grand merci

Cordialement.
Johann

 

[eriiic]

Bonjour,a feuille A COMPLETER est protégée...


non, ça ne peut être fait que par macro.
Le format est le même sur l'ensemble de la ligne (ou colonne) ?
Ta feuille A COMPLETER est protégée...
eric

 

[Aile2poulet]

Bonjour,
Merci pour votre retour. J'ai remis le fichier en supprimant la protection. Désolé

 

[eriiic]

Bonjour,

et la réponse à la question ?
eric

 

[Aile2poulet]

Pour répondre à la question,
Feuille "A COMPLETER", pour chaque colonne, les cases en pointillés rouges pour les niveaux 1, 2, 3 et 4 répondent au même format (hormis pour la ligne CV acceptation CQI). Par exemple, le nombre de décimales définit dans la colonne C dépendra du choix de la cellule C7, pour la colonne D ce sera la cellule D7, etc... Pour cette feuille, je pense que tout est OK. J'ai utilisé des mises en forme conditionnelles
Feuille "Rapport à imprimer", la fonction TRANSPOSE reprend les lignes "limite basse et limite haute" pour les 4 niveaux de la feuille "A COMPLETER", le nombre de décimale doit être celui être le même que celui affiché dans la feuille "A COMPLETER".

Pour être plus explicite, j'ai complété le fichier avec un exemple test (TEST1, TEST2, TEST3 et TEST4) avec des nombres de décimales pour chaque TEST. Dans l'onglet, on constate que l'affichage n'est pas correct....

Je sèche... :-(

 

[eriiic]

Tant que j'y étais j'ai fait aussi la feuille 'A COMPLETER', ça fait toujours 4 MFC en moins, et rien à retoucher si tu augmentes le nombre de décimales possibles.

Conditions à respecter :
- feuille 'A COMPLETER' :
. "Nb de décimales" en colonne B en respectant maj/min
. idem pour "CV acceptation CQI"
La mise à jour se fait au moment du choix dans la ligne Nb de décimales.
Toute la colonne est mise au format. Si ça gêne pour les premières lignes, le préciser, je complèterai.

- feuille 'Rapport à imprimer' :
. "PARAMETRES" en colonne A en respectant maj/min
. les cellules juste en-dessous doivent contenir la matrice des noms des tests.
Ici : à partir de A6 donc. J'y récupère les colonnes concernées dans la formule pour récupérer les tableau des décimales. Si elle change il faudra adapter le code en conséquence.
La mise à jour se fait à l'activation de la feuille
eric

 

[Aile2poulet]

Impressionnant! Merci mille fois Eric.
Dans la feuille "A COMPLETER", est-il possible d'appliquer le format uniquement à partir de la ligne 10?
Je vais essayer de comprendre comment vous avez réalisé la macro, je serai moins bête et je pourrai l'appliquer sur d'autres fichiers.
Merci encore, c'est vraiment très gentil de votre part.

 

[eriiic]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range, pl As Range, adr1 As String
    If Cells(Target.Row, 2) = "Nb de décimales" Then
        If IsNumeric(Target.Value) Then
            Set pl = Cells(10, Target.Column).Resize(Cells(Rows.Count, 2).End(xlUp).Row - 9)
            If Target = 0 Then pl.NumberFormat = "0" Else pl.NumberFormat = "0." & Application.Rept("0", Target.Value)
            Set c = Columns(2).Find("CV acceptation CQI", LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                adr1 = c.Address
                Do
                    Rows(c.Row).NumberFormat = "0.0"
                    Set c = Cells.FindNext(c)
                Loop While c.Address <> adr1 And Not c Is Nothing
            End If
        End If
    End If
End Sub

si tu ajoutes des niveaux il faudra revalider toutes tes Nb de décimales pour l'appliquer aux nouvelles lignes.
Si c'est fréquent on peut l'automatiser.
eric

 

[Aile2poulet]

Pour l'utilisation actuelle, c'est parfait!
J'ai juste une dernière question: est-il possible de verrouiller les feuilles avec les macros? J'ai une fenêtre de débogage qui apparait.

 

[Aile2poulet]

J'ai renseigné dans "ThisWorkbook"
Sub ProtectionSaufMacro("A COMPLETER")
ActiveSheet.Protect UserInterfaceOnly:=True
End Sub
mais ca ne fonctionne pas

 

[eriiic]

Le plus simple est de les protéger par macro en bloquant uniquement l'utilisateur et pas les macros :
à mettre dans Thisworkbook :

Private Sub Workbook_Open()
    Sheets("Rapport à imprimer").Protect Password:="pw", UserInterfaceOnly:=True ' mettre ton mot de passe ou supprimer Password:="pw" s'il n'y en a pas
End Sub

eric

Edit : tu étais sur la bonne piste ;-)

 

[Aile2poulet]

Ca marche!!!!!!!
Merci encore et encore!!!
(je suis trop content)

 

[Aile2poulet]

Bonjour,
Je voulais ajouter des lignes supplémentaires sur la feuille "A COMPLETER" qui ne soient pas impactées par le nombre de décimales (idem que pour la ligne "CV acceptation CQI"). J'ai complété pour les lignes "Ecart-type" et "CV période probatoire":

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, pl As Range, adr1 As String
If Cells(Target.Row, 2) = "Nb de décimales" Then
If IsNumeric(Target.Value) Then
Set pl = Cells(10, Target.Column).Resize(Cells(Rows.Count, 2).End(xlUp).Row - 9)
If Target = 0 Then pl.NumberFormat = "0" Else pl.NumberFormat = "0." & Application.Rept("0", Target.Value)
Set c = Columns(2).Find("CV acceptation CQI", LookIn:=xlValues, lookat:=xlWhole)
Set c = Columns(2).Find("Ecart-type", LookIn:=xlValues, lookat:=xlWhole)
Set c = Columns(2).Find("CV période probatoire", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
adr1 = c.Address
Do
Rows(c.Row).NumberFormat = "0.0"
Set c = Cells.FindNext(c)
Loop While c.Address <> adr1 And Not c Is Nothing
End If
End If
End If
End Sub

mais ca ne fonctionne pas, comment puis-je appliquer l'exclusion aux 3 lignes simultanément? Dur dur VBA
Je vous remets le fichier en pièce jointe.

 

[eriiic]

Bonjour,

il faut copier 3 fois le bloc

            Set c = Columns(2).Find("CV acceptation CQI", LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                adr1 = c.Address
                Do
                    Rows(c.Row).NumberFormat = "0.0"
                    Set c = Cells.FindNext(c)
                Loop While c.Address <> adr1 And Not c Is Nothing
            End If

en changeant la chaine et éventuellement le format à appliquer.
eric

 

[Aile2poulet]

Merci Eric, ca fonctionne pour le premier onglet. Cependant sur la seconde feuille, les colonnes K à R affiche les règles de décimales de la première feuilles. Est-il possible de transposer sans règle de décimales uniquement sur ces colonnes, j'ai essayé des codes d'exclusion mais ca ne fonctionne pas.
(Je fais mon possible pour comprendre, désolé)