[VBA] Forcer le collage de valeur sur une plage spécifique

Question

Je souhaiterai forcer l'utilisateur à coller en valeur et ce sur une plage spécifique (qui change selon les classeurs) Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range) On Error Resume Next 'sécurité With Application If .CutCopyMode Then .EnableEvents = False .Calculation = xlManual .Undo Selection.PasteSpecial xlPasteValues .OnUndo "", "" .OnRepeat "", "" .Calculation = xlAutomatic .EnableEvents = True End If End With End Sub J'ai trouvé ce code sur l'internet, source Problème... la plage de cellules concernée contient déjà un code qui s'exécute au Worksheet_Change, donc le .undo ne fonctionne pas zut ! Le code avec la plage de cellule concernée: Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Sheets("Calculs").Range("H2") = True Then Exit Sub For Each cel In Target.Cells If Not Application.Intersect(cel, Range("B17:B31, D17:D31, F17:F31, H17:H31, J17:J31, L17:L31, N17:N31, P17:P31")) Is Nothing Then Me.Unprotect If cel.Value = "" Then cel.Interior.ColorIndex = -4142 cel.Comment.Delete Else cel.Interior.ColorIndex = 2 cel.AddComment cel.Comment.Text Text:="Valeur figée car rentrée mannuellement" End If Me.Protect End If Next cel End Sub Merci de votre aide. Gabin...

Dan · Accepted Answer

Cela va alourdir le fichier mais bon vous pouvez essayer ce code. Code à placer dans chaqu'une des 3 feuilles CAPA de votre fichier Attention que l'instruction Me.protect ne permet pas de dupliquer les feuilles Private Sub Worksheet_Change(ByVal Target As Range) Dim Lig As Byte Dim cel As Range, Plage As Range, c As Range On Error Resume Next If Sheets("Calculs").Range("H2") = True Then Exit Sub For Each c In Range("A17:A" & Range("A" & Rows.Count).End(xlDown).Row) If Not IsNumeric(Range("A" & c.Row)) Then Lig = c.Row - 1: Exit For Next c Set Plage = Union(Range("B17:B" & Lig), Range("D17:D" & Lig), Range("F17:F" & Lig), Range("H17:H" & Lig), Range("J17:J" & Lig), Range("L17:L" & Lig), Range("N17:N" & Lig), Range("P17:P" & Lig)) For Each cel In Plage If Not Application.Intersect(cel, Plage) Is Nothing Then Me.Unprotect If cel.Value = "" Then cel.Interior.ColorIndex = -4142 cel.Comment.Delete Else With cel .Interior.ColorIndex = 2 .NumberFormat = "0.00" .BorderAround LineStyle:=xlContinuous .AddComment .Comment.Text Text:="Valeur figée car rentrée mannuellement" With .Font 'police .Name = "Arial" .Color = -65536 .Size = 10 End With End With End If End If Next cel Me.Protect End Sub Cordialement...

Dan · Accepted Answer

Bon je vous donne tout de même ce que j'ai fait

1. Dans chacune de vos feuilles CAPA, mettez ce code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Feuille As String

If Sheets("Calculs").Range("H2") = True Then Exit Sub
Feuille = ActiveSheet.Name
Call miseenforme(Feuille)
End Sub

2. Dans un module mettez ce code

Sub miseenforme(Feuille As String)
Dim Lig As Byte
Dim cel As Range, Plage As Range, c As Range

With Sheets(Feuille)
    For Each c In .Range("A17:A" & Range("A" & Rows.Count).End(xlDown).Row)
        If Not IsNumeric(.Range("A" & c.Row)) Then Lig = c.Row - 1: Exit For
    Next c

    Set Plage = Union(.Range("B17:B" & Lig), .Range("D17:D" & Lig), .Range("F17:F" & Lig), .Range("H17:H" & Lig), .Range("J17:J" & Lig), .Range("L17:L" & Lig), .Range("N17:N" & Lig), .Range("P17:P" & Lig))

    On Error Resume Next

    For Each cel In Plage
        If Not Intersect(cel, Plage) Is Nothing Then
            Sheets(Feuille).Unprotect
            If cel.Value = "" Then
                cel.Interior.ColorIndex = -4142
                cel.Comment.Delete
            Else
                With cel
                    .Interior.ColorIndex = 2
                    .NumberFormat = "0.00"
                    .BorderAround LineStyle:=xlContinuous
                    .VerticalAlignment = xlVAlignCenter
                    .HorizontalAlignment = 3
                    .AddComment
                    .Comment.Text Text:="Valeur figée car rentrée mannuellement"
                    With .Font 'police
                        .Name = "Arial"
                        .Color = -65536
                        .Size = 10
                    End With
                End With
            End If
            Sheets(Feuille).Protect
        End If
    Next cel
End With
End Sub

Le code au point 2 sera appelé à chaque modification de votre feuille Capa

Cordialement

Edit : ajouté ligne If not Intersect....

Dan · Answer

Je n'ai pas bien compris votre souci. Vous pourriez donner un exemple que je reproduise ? Exemple pour la feuille Capa 30 graph : Vous collez des valeurs depuis B17 à B31 en une seule fois ou cellule par cellule ? Lorsque vous copiez, les valeurs viennent d'où ...

Dan · Answer

Les valeurs copiées sont le résultat de formules éventuelles ou simplement des valeurs ?

Cette question parce que copier une cellule qui contient une formule et la coller ailleurs ne donne pas le même résultat que s'il s'agit uniquement de valeurs

Là comme je comprends il s'agit d'avoir le bon format final après le collage

Edit : autre question au sujet des codes. Il y a en un dans les feuilles Graph et un dans Thisworkbook. Et il agissent tous les deux. Est-ce que celui de Thisworkbook peut être supprimé ?

Dan · Answer

Ok. Je ne suis pas sûr que c'est cette solution que vous cherchez mais si vous mettez simplement cette ligne en dessous de la ligne COLORINDEX = 2 de la partie Else cel.NumberFormat = "0.00" Edit : autre question, le nom des 3 feuilles commence toujours par CAPA ...

Dan · Answer

Les bordures c'est assez simple à faire Les couleurs... vous parlez de la couleur de la police de caractère ( bleue ?) On peut arranger cela au départ en utilisant le codename. C'est votre ficher original qui est posté ...

Dan · Answer

Pourquoi les dupliquer ? On a dit depuis le début que seules 3 feuilles étaient concernées puis on peut interdire l'ajout de feuilles aussi

En fait pas exactement j'ai du mal m'exprimer. Il existe 3 feuilles de 30,60 et 120 valeurs selon le besoin de l'utilisateur. Chaque feuilles peut contenir 4 mesures, si l'utilisateur a besoin de plus il peut copier/coller les feuilles a volonté... *

J'ai compris pour le codename, je ne connaissais pas ca me sera grandement utile par la suite.

Je pense que nous devons trouver un code contenue directement dans la feuille (juste a le copier coller pour les 2 autres feuilles)

Comme cela on règle le problème des feuilles dupliquer.

Dan · Answer

Non là il n'est pas lourd mais quand vous êtes obligé de l'avoir dans chaque feuille parce que l'utilisateur peut ne avoir besoin, cela ne simplifie pas. Non avec le Target cela ne fonctionne pas sinon je vous l'aurais laissé. L'avantage ici est que l'on n'a pas besoin d'adapter la plage dans chaque feuille. La dernière ligne 31 ou 46 ou autre est déterminée par le code. Par contre on peut faire en sorte de mettre une partie de code dans un module parce qu'il sera récurrent. Il faut juste repérer le nom de la feuille concernée pour qu'il soit vu dans le code placé dans le module. Si vous voulez je modifie pour vous proposer cette solution...