VBA et DEVERROUILLAGE DE CELLULES SUR FEUILLES PROTEGEES

[mordox]

Bonjour,

j'ai vraiment besoin d'aide sur un codage vba qui ne fonctionne pas.

Je génère via une macro principale plusieurs onglets que je sépare en plusieurs fichiers excel ==> tout fonctionne

Je voudrai simplement ajouter un fonctionnement de verrouillage d'une certaine quantité de cellules dans mes nouveaux fichiers excel créés et là rien ne va plus.

Voici mon code où j'essaie de laisser déverrouillé une plage de cellule mais ça ne fonctionne pas car toute la nouvelle feuille excel se verrouille entièrement : ça ne tient pas compte de ma plage G14 à I22 que je voudrais laisser libre à tous les futurs utilisateurs de ces fichiers :

PLEASE HELP

MERCI d'avance

-----------------------------------------------------------------------------------------------

Sub SAUVEGARDE_ONGLET()

chemin = ThisWorkbook.Path & "\"
For m = 1 To Sheets.Count
Sheets(m).Copy
With ActiveWorkbook

Active.Range("G14:I22").Select
ActiveSheet.Protection.AllowEditRanges.Add Title:="Plage1", Range:=Range("G14:I22")
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

.SaveAs Filename:=chemin & Sheets(1).Name & ".xlsx"
.Close
End With
Next

End Sub

----------------------------------------------------------------------------------------------------------------

 

[Papou-net]

Re : VBA et DEVERROUILLAGE DE CELLULES SUR FEUILLES PROTEGEES

Bonsoir mordox, et bienvenue sur XLD,

Je te propose d'essayer comme suit:

Sub SAUVEGARDE_ONGLET()
chemin = ThisWorkbook.Path & "\"
For m = 1 To Sheets.Count
       Sheets(m).Copy
       With ActiveWorkbook
             .ActiveSheet.Range("G14:I22").Locked = False
             .ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
             .SaveAs Filename:=chemin & Sheets(1).Name & ".xlsx"
             .Close
       End With
Next
End Sub

A +

Cordialement.

 

[mordox]

Re : VBA et DEVERROUILLAGE DE CELLULES SUR FEUILLES PROTEGEES

Bonjour PAPOU-NET,

merci de ta réponse rapide, je viens de tester ton code, il passe sans bugger mais je me retrouve avec toute la nouvelle feuille verrouillé, j'ai l'impression que la ligne

.ActiveSheet.Range("G14:I22").Locked = False

n'est pas prise en compte.

En trainant sur pas mal de forum aujourd'hui, j'ai cru comprendre
1) qu'il faut déverrouiller la feuille ==> qui n'est pas verrouillée de mon côté
2) Passer à False effectivement les cellules que l'on ne veut pas verrouiller
3) Reverrouiller la feuille entière

==> tu restes dans la logique de ce que j'ai cru comprendre mais pourquoi ça ne me les garde pas libre?

Merci d'avance à toi et les autres

 

[Papou-net]

Re : VBA et DEVERROUILLAGE DE CELLULES SUR FEUILLES PROTEGEES

RE:

C'est pour le moins curieux: si je clique sur Fin dans le message d'erreur, je constate que la feuille est bien protégée en dehors de la plage spécifiée reste modifiable. J'ai tenté de mettre Application.DisplayAlerts = False mais le message persiste.

Peux-tu joindre une copie édulcorée de ton fichier?

A +

Cordialement.

 

[mordox]

Re : VBA et DEVERROUILLAGE DE CELLULES SUR FEUILLES PROTEGEES

Bonjour PAPOU-NET,

Quand j'extrais de mon programme principal ce que tu me proposes, c'est parfait cela fonctionne.

Quand je laisse cette fonction et que je l'appelle dans mon programme principal, elle verrouille toute la feuille.

voici mon programme principal :

1) les déclarations de variables
2) les sous-programmes
3) le programme principal qui se nomme : "Sub A_XXXXX_HORS_ELEC()"

Desolé si c'est un peu fouilli



Public LigAdr As String
Public Adresse As String
Public i As Integer
Public j As Integer
Public f As Integer
Public DateInter As String
Public DomTeck As String
Public LigDomTeck As String
Public Loc1 As String
Public Loc2 As String
Public Loc3 As String
Public Famille As String
Public Nature As String
Public Marque As String
Public Typ As String
Public NumSerie As String
Public NumInterne As String
Public Observation As String
Public dat As String
Public sh1 As Worksheets
Public nbcells As Integer
Public aff As String
Public prest As Integer
Public inter As Integer

Public Adresseprec As String
Public DomTeckprec As String
Public DateInterprec As String
Public Loc1prec As String
Public Loc2prec As String
Public Loc3prec As String
Public Familleprec As String
Public Natureprec As String
Public Marqueprec As String
Public Typprec As String
Public NumSerieprec As String
Public NumInterneprec As String
Public Observationprec As String
Public datprec As String

Public m As Byte
Public chemin As String
------------------------------------------------------------------------------------------------
Sub SAUVEGARDE_ONGLET()
chemin = ThisWorkbook.Path & "\"
For m = 1 To Sheets.Count
Sheets(m).Copy
With ActiveWorkbook
.ActiveSheet.Range("G14:I22").Locked = False
.ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
.SaveAs Filename:=chemin & Sheets(1).Name & ".xlsx"
.Close
End With
Next
End Sub
---------------------------------------------------------------------------------------------------------------
Sub AFFICHE_DONNEES() 'affiche dans la feuille OT les données dans les bonnes cellules

ActiveSheet.Range("H10") = DateInter
ActiveSheet.Range("B3") = Adresse & " " & Loc1 & " " & Loc2
ActiveSheet.Range("B7") = Famille & "/" & Nature & "/" & Marque & "/" & Typ & "/" & NumSerie & "/" & NumInterne
ActiveSheet.Range("A14") = Observation
ActiveSheet.Range("F14") = dat
ActiveSheet.Range("B9") = Date
ActiveSheet.Range("C10") = aff & "/" & prest & "/" & inter

If (DomTeck = "LV-VP" Or DomTeck = "LV-VC" Or DomTeck = "LV-GTVP") Then
ActiveSheet.Range("B5") = "LEVAGE"
Else
If DomTeck = "PO-VP" Then
ActiveSheet.Range("B5") = "PORTE"
Else
If DomTeck = "TB-GZ-VP" Then
ActiveSheet.Range("B5") = "GAZ"
Else
If DomTeck = "IN-MS-VP" Then
ActiveSheet.Range("B5") = "INCENDIE"
Else
If DomTeck = "MD-VP" Then
ActiveSheet.Range("B5") = "MACHINE"
Else
If DomTeck = "EP-CH-VP" Then
ActiveSheet.Range("B5") = "E.P.I"
Else
End If
End If

End If

End If
End If
End If

End Sub

------------------------------------------------------------------------------------------------------------
Sub RECUP_TABLEAU() 'récupération des données du requeteur
Adresse = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("H" & i)
DomTeck = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("K" & i)
DateInter = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("G" & i)
Loc1 = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("L" & i)
Loc2 = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("M" & i)
Loc3 = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("N" & i)
Famille = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("P" & i)
Nature = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("Q" & i)
Marque = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("R" & i)
Typ = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("S" & i)
NumSerie = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("T" & i)
NumInterne = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("U" & i)
Observation = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("V" & i)
dat = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("W" & i)
aff = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("B" & i)
prest = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("C" & i)
inter = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("D" & i)
End Sub
-----------------------------------------------------------------------------------------------------------
Sub RECUP_LIGNE_PREC() 'recupere les données de la ligne précédente

Adresseprec = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("H" & i)
DomTeckprec = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("K" & i)
DateInterprec = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("G" & i)
Loc1prec = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("L" & i)
Loc2prec = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("M" & i)
Loc3prec = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("N" & i)
Familleprec = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("P" & i)
Natureprec = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("Q" & i)
Marqueprec = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("R" & i)
Typprec = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("S" & i)
NumSerieprec = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("T" & i)
NumInterneprec = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("U" & i)
Observationprec = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("V" & i)
datprec = Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("W" & i)

End Sub
------------------------------------------------------------------------------------------------------------
Sub A_XXXXX_HORS_ELEC()

nbcells = Application.WorksheetFunction.CountA(Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("$A:$A"))
MsgBox nbcells

i = 2
j = 14
f = 1

RECUP_TABLEAU
RECUP_LIGNE_PREC

Sheets("MODELE HORS ELEC").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = DomTeck & f

AFFICHE_DONNEES
i = i + 1
RECUP_TABLEAU

If Workbooks("XXXXX.xlsx").Sheets("XXXXX 2015 HE").Range("G" & i).Value <> "" Then
While i <= nbcells
If DateInter = DateInterprec Then

If DomTeck = DomTeckprec Then

If Adresse = Adresseprec Then

If NumSerie = NumSerieprec Then

j = j + 1
ActiveSheet.Range("A" & j) = Observation
ActiveSheet.Range("F" & j) = dat
i = i + 1

Else
j = 14

Sheets("MODELE HORS ELEC").Copy After:=Sheets(Sheets.Count)
f = f + 1
ActiveSheet.Name = DomTeck & f

AFFICHE_DONNEES

i = i + 1

RECUP_TABLEAU

End If

Else

Sheets("MODELE HORS ELEC").Copy After:=Sheets(Sheets.Count)
f = f + 1
ActiveSheet.Name = DomTeck & f

j = 14

AFFICHE_DONNEES
i = i + 1
RECUP_TABLEAU

End If

Else

Sheets("MODELE HORS ELEC").Copy After:=Sheets(Sheets.Count)
f = f + 1
ActiveSheet.Name = DomTeck & f

j = 14

AFFICHE_DONNEES

i = i + 1

RECUP_TABLEAU


End If

Else

Sheets("MODELE HORS ELEC").Copy After:=Sheets(Sheets.Count)
f = f + 1
ActiveSheet.Name = DomTeck & f


j = 14

AFFICHE_DONNEES

i = i + 1

RECUP_TABLEAU

End If

RECUP_LIGNE_PREC


Wend


Else
End If

SAUVEGARDE_ONGLET

End Sub
-------------------------------------------------------------------------------------

 

[mordox]

Re : VBA et DEVERROUILLAGE DE CELLULES SUR FEUILLES PROTEGEES

En fait le but de ce programme est de récupérer d'un fichier excel brut de pomme des données pour les mettre en forme selon un modèle principal.

Ces données seront après plusieurs test réparti en de nombreux onglets de fichier excel.
Les onglets auront des noms variables.
Par la suite je crée un fichier excel par onglet.

==> j'ai comme l'impression que je me mélange les pinceaux en appelant la fonction ActiveSheet. Il ne sait peut-être plus où il en est??

 

[Papou-net]

Re : VBA et DEVERROUILLAGE DE CELLULES SUR FEUILLES PROTEGEES

Bonsoir mordox,

Peut-être que si tu pouvais joindre une copie allégée de ton fichier, avec des données fictives, pour mieux suivre le déroulement du code?

A +

Cordialement.