Mise en forme et verrouillage selon condition

[ShuarS]

Bonjour,

Pourriez-vous m’aider à réaliser un code VBA pour le fichier joint svp ?

Pour faire simple, voici ce que j’essaie de faire :
- Toutes les cellules bloquées en écriture avec mdp pour modification
- Si Bx = non vide alors Cx:TZx libre en écriture avec des chiffres uniquement sans mdp

L’idée est de construire un fichier « de base » sur lequel les colonnes A et B seraient vides.
Après un copier-coller de ces mêmes colonnes, le lancement de la macro réaliserait les étapes suivantes :
- Extension de la mise en forme de la colonne B sur toutes les colonnes à droite de celle-ci ;
- Blocage des cellules avec mdp ;
- Ouvrir l’accès en écriture (chiffre uniquement) de toutes les lignes (de C à TZ par ex) si la cellule de B est non vide.

J’ai déjà une macro pour reproduire ma mise en forme de la colonne B sur les colonnes C à TZ :

Sub test()
With Worksheets("Feuil1")
.Range("B2:B50").Copy
.Range("C2:TZ50").PasteSpecial xlPasteFormats
End With
Application.CutCopyMode = False
End Sub

J'ai un bout de code pour identifier les cellules non vides en colonne B puisque celles ci peuvent être variable d'un copier-coller à un autre.

Sub testnonvide()
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
    If Not IsEmpty(Range("B" & i)) Then Range("C" & i) = ""
Next
End Sub

Seulement pour le moment je ne sais pas écrire le code pour traiter les lignes entières.

Si une âme charitable passe par ici pour m'aider je suis preneur


Merci de votre aide,
Shu

 

[job75]

Bonsoir ShuarS, bienvenue sur XLD,

Sur le fichier joint exécutez cette macro par les touches de raccourci Ctrl+R :

Sub Reset()
'se lance par les touches Ctrl+R
Application.ScreenUpdating = False
With Feuil1 'CodeName
    .Unprotect "toto" 'mot de passe à adapter
    .[C:C].Resize(, .Columns.Count - 2).ClearFormats 'RAZ
    .Cells.Locked = True 'verrouille toutes les cellules
    .Cells.Validation.Delete 'supprime toutes les validation des données
    .[B:B].AutoFill .[B:TZ], xlFillFormats 'copie les formats
    On Error Resume Next 'si aucune SpecialCell
    With Intersect(.Range("B2:B" & .Rows.Count).SpecialCells(xlCellTypeConstants).EntireRow, .[C:TZ])
        .Locked = False 'déverrouille les cellules
        .Value = ""
        .Validation.Add xlValidateWholeNumber, Formula1:="0", Formula2:="10000000000"
    End With
    .Columns.AutoFit 'largeurs des colonnes
    .Protect "toto"
End With
End Sub

La feuille sera protégée avec le mot de passe toto.

A+

 

[ShuarS]

@job75 , MERCI VRAIMENT !

Pourrais tu me dire comment intégrer dans ton code une mise en forme spécifique pour la ligne 2 (de C2 à TZ2 par ex.) ?
Car ton code supprime la mise en forme "Date". J'aimerais une écriture à 45° comme sur le fichier ci joint. J'ai fait la modification avec l'enregistreur, ça donne ceci :

Option Explicit

Sub Macro2()

    Range("C1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.NumberFormat = "m/d/yyyy"
   
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 45
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
   
    With Selection.Font
        .Name = "Arial monospaced for SAP"
        .FontStyle = "Normal"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -13224394
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
   
    Columns("C:C").EntireColumn.AutoFit
    Columns("C:C").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Columns("C:TZ").EntireColumn.AutoFit
    Columns("C:C").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
   
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = -3359823
        .TintAndShade = 0
        .Weight = xlThick
    End With
   
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -3359823
        .TintAndShade = 0
        .Weight = xlThin
    End With
   
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Range("A1").Select
   
End Sub

Je ne vois pas trop comment intégrer proprement tout ça dans ton code.

Merci pour la bienvenue, je vais voir également si je peux répondre à quelques questions diverses.

Shu

 

[job75]

Ne bricolez pas mon code !

La mise en forme Date de C1:TZ1 est supprimée en effet mais j'ai mis B1 au format Date donc elle est restituée.

Pour la mise en forme à 45°de C1:TZ1 mettre B1 au format 45°.

 

[ShuarS]

Bonjour @job75 ,
Ok je vais tester ça merci.

Bonne journée,
Shu

 

[ShuarS]

@job75 , Savez vous comment autoriser l'écriture de deux décimales dans les lignes non bloquées ?

Actuellement je suis limité sur les nombres entiers. J'aimerais pouvoir écrire 6,48 par exemple.

Merci

 

[job75]

J'attends une réponse pour la solution que j'ai donnée au post #4.

 

[job75]

@job75Actuellement je suis limité sur les nombres entiers. J'aimerais pouvoir écrire 6,48 par exemple.

Vous avez dit "ligne libre en écriture avec des chiffres uniquement", la virgule n'est pas un chiffre...

Si vous voulez permettre l'entrée de nombres décimaux remplacez dans ma macro :

.Validation.Add xlValidateWholeNumber, Formula1:="0", Formula2:="10000000000"

par :

.Validation.Add xlValidateDecimal, Formula1:="0", Formula2:="10000000000"

 

[ShuarS]

Parfait merci pour vos retours rapides !

 

[ShuarS]

@job75 , pensez vous qu'il existerait une solution pour ne pas effacer les nombres écrits dans les lignes autorisées en cas d'un second déclenchement de la macro ?

Je m'explique :
1. Fichier de base vide ;
2. Collage de données dans les colonnes A & B ;
3. Lancement de la macro ;
4. Saisi de nombre dans les lignes autorisées ;
5. Ajout de données dans les colonnes A & B sous les données déjà existantes ;
6. Second lancement de la macro pour ces nouvelles données.

Au moment de l'opération 6, la macro effectue très bien la tâche demandée, mais tous les nombres déjà inscrits sont effacés.
J'aimerais les conserver.
Je n'arrive pas à écrire cette condition supplémentaire : SI cellule non vide alors no wipe…

Mais ma demande n'est peut être pas possible.

Qu'en pensez vous ?

 

[job75]

Il faut faire une 2ème macro identique à la 1ère sauf qu'elle n'effacera pas les valeurs, je vous laisse l'écrire.

 

[ShuarS]

Bonjour @job75 ,

J'ai peur que cela ne soit pas aussi simple.

J'ai bien dupliqué la macro et commenté les lignes suivantes :

'.[D:D].Resize(, .Columns.Count - 2).ClearFormats
 '.Cells.Validation.Delete

Mais je pense qu'au moment du collage spécial, celui ci supprime les données.
Il faudrait pouvoir modifier par un collage spécial de mise en forme.

Selection.PasteSpecial Paste:=xlPasteFormats

 

[job75]

J'ai peur que cela ne soit pas aussi simple.

Dans la macro du post #2 supprimez la ligne .Value = ""

 

[ShuarS]

Rooo et ça marche en plus

Merveilleux ! Vous êtes très bon merci