problème dans une macro excel

P

philippe81

Habitué
Bonsoir, je vais essayer d'expliquer le problème le plus clairement possible.
J'ai un classeur excel avec 4 feuilles pour la gestion des licenciés de mon association sportive.
Dans la première j'ai tous les noms des joueurs avec leur numéro de licence ainsi que les sports pratiqués.
Une première macro récupère tous les joueurs d'un sport et les copie dans la feuille correspondante, et
ceux-ci pour les 3 sports.
Maintenant je souhaite créer un classeur nommé "BB M + date.xls" pour donner au responsable de l'équipe.
De même pour HB M et F M.
Dans le code qui suit, seule le classeur avec les licenciés de basket masculin est protégé en totalité.
Les deux autres classeurs ne sont pas protégés et je ne voit pas où est le problème.
Je planche sur le code depuis toute l'après midi ( je suis débutant ....) et je ne voit pas le problème
qui est probablement minime.

Merci pour votre aide

philippe

[cpp]
Sub sauve()
Dim dossier As String
dossier = ActiveWorkbook.Path
Application.DisplayAlerts = False '' pour enlever les messages du type "Un fichier porte déjà ce nom" lors de la sauvegarde

'' basket ball masculin
Sheets("BB M").Select
Sheets("BB M").Copy
ActiveWorkbook.SaveAs Filename:=dossier & "\BB M" & "-" & Year(Date) & Month(Date) & Day(Date) & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Cells.Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="mdp", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Password:="mdp", Structure:=True, Windows:=False

ActiveWorkbook.Save
ActiveWorkbook.Close

'' handball masculin
Sheets("HB M").Select
Sheets("HB M").Copy
ActiveWorkbook.SaveAs Filename:=dossier & "\HB M" & "-" & Year(Date) & Month(Date) & Day(Date) & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Cells.Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="mdp", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Password:="mdp", Structure:=True, Windows:=False

ActiveWorkbook.Save
ActiveWorkbook.Close

'' volley ball masculin
Sheets("VB M").Select
Sheets("VB M").Copy
ActiveWorkbook.SaveAs Filename:=dossier & "\VB M" & "-" & Year(Date) & Month(Date) & Day(Date) & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Cells.Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="mdp", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Password:="mdp", Structure:=True, Windows:=False

ActiveWorkbook.Save
ActiveWorkbook.Close

Application.DisplayAlerts = True
End Sub

[/cpp]
 
zeb

zeb

Modérateur
Ton code est véritablement horrible. (Code de débutant, quoi que je n'en suis pas si sûr ;) )
Pourquoi faire tous ces Select ?
Comment être sûr de ce que l'on fait quand on accède à l'objet actif ?

Bon, je te propose de faire une fonction générique, puis de l'appliquer plusieurs fois :

Code: 
Sub Sauve_1(Nom As String)
    Dim master_wb As Workbook
    Dim new_wb As Workbook
    
    Set master_wb = ActiveWorkbook
    
    master_wb.Sheets(Nom).Copy
    Set new_wb = ActiveWorkbook
    
    Application.DisplayAlerts = False
    new_wb.SaveAs Filename:=master_wb.Path & "\" & Nom & "-" & Year(Date) & Month(Date) & Day(Date) & ".xls"
    Application.DisplayAlerts = True

    new_wb.Sheets(1).Cells.Locked = True
    new_wb.Sheets(1).Cells.FormulaHidden = False
    new_wb.Sheets(1).Protect Password:="mdp", DrawingObjects:=True
    new_wb.Protect Password:="mdp", Structure:=True, Windows:=False
   
    new_wb.SaveAs   ' <------ ERREUR !!!!
    new_wb.Close
    
    Set new_wb = Nothing
    Set master_wb = Nothing
End Sub

Pas de Select/Selection ni de Activate/ActiveTruc
Evidemment, ligne 8, je suis obligé de faire confiance à Excel... Beurk.
Pour les DisplayAlert, surtout à utiliser avec parcimonie. Et donc encadrer au plus près la fonction qui le nécessite.

Code: 
Sub Sauve_plusieurs()
    Sauve_1 "BB M"
    Sauve_1 "HB M"
    Sauve_1 "VB M"
    Sauve_1 "VB M"
End Sub

Qu'en dis-tu ?
 
P

philippe81

Habitué
Disons que j'essaie d'utiliser les macros depuis quelques temps, mais il est vrai que je cherche rarement à simplifier et à minimiser le travail de la machine, du moment qu'elle a fait ce que j'attendais.... c'est un défaut.

Les select me servaient à mettre les cellules en mode verrouillé pour ensuite bloquer complétement leur accès, et que le destinataire ne puisse qu'imprimer ce que je lui envoie sans apporter aucune modification.

C'est vrai que ça fait déjà plus propre comme ça

La fonction générique m'aurait demandé beaucoup plus de réflexion, je dois avouer que la programmation n'est pas trop ma spécialité..... (ça se voit!)

Après plusieurs minutes de lecture, j'avais l'impression de comprendre ce que tu lui fais faire, mais après l'avoir testé sur mon fichier excel, aucun des fichiers créés n'est protégé. Et là, je vois vraiment pas ce qui ne va pas parce que j'étais convaincu par le code.


J'essai de le modifier, mais si tu peux encore m'aider.... merci d'avance

Philippe
 
zeb

zeb

Modérateur
Attention de ne pas te tromper de forum, ici on parle de programmeur à programmeur.
Dans ce monde, il faut TOUJOURS faire les choses PROPRES. Et ne jamais lésiner sur la REFLEXION.
Il faut aussi bien comprendre ce que l'on fait, ou quand on demande de l'aide, ce que l'on fait faire.
(Ce que tu as fais, j'en suis très content). L'erreur vient de moi, et seulement de moi.

Cela a échapper à ta relecture : ligne 19 de mon code, j'ai mis un SaveAs. Il faut faire un Save tout court.
Ben oui, ce n'est pas ton fichier protégé mais une copie non protégée qui est copiée par dessus !
(D'où le message d'avertissement qui aurait dû te mettre la puce à l'oreille)

Alors, comme ça, ça marche ?
 
zeb

zeb

Modérateur
Encore une chose, ta façon de nommer ton fichier est très moche.
Le 1 décembre (aujourd'hui ;) ) et le 21 janvier sont 12 1 et 1 21, soit tout attaché, 121 pour les deux. Ajoute des zéros :

Aide directe et gratuite sans avoir à réfléchir pour me faire pardonner du SaveAs précédent :whistle: :
Code: 
new_wb.SaveAs Filename:=master_wb.Path & "\" & Nom & "-" & Format(Now, "yyyymmdd") & ".xls"
 
P

philippe81

Habitué
J'essairai de faire les efforts nécessaire pour être admis sur ce forum!!

c'est malheureux, mais le SaveAs ne me choquait pas du tout...
j'ai modifié cette ligne de commande

par contre pour éviter les problèmes, j'ai enlevé la date du nom de fichier d'enregistrement.

Malheureusement, la protection n'a fonctionné que pour le premier classeur "BB M", ensuite les suivants ne sont pas protégés, et ça je comprends pas, parce qu'on définit des workbooks "temporaires" mais avant de quitter la procédure, on les déclare comme n'étant plus rien, donc ça devrait recommencer ensuite sans problème.

j'ai tenté de modifier la procédure Sauve_plusieurs en lui faisant:
[cpp]
Sub Sauve_plusieurs()
Sauve_1 "HB M"
Sauve_1 "BB M"
Sauve_1 "VB M"
End Sub
[/cpp]
pour qu'il sauvegarde d'abord la page handball avant la basket ball, mais cette fois, c'est pas la 1ère page qui est sauvegardé protégée mais la seconde, donc toujours "BB M"....
ne voyant pas ce que je peux faire, j'ai même essayé de déplacer les pages du classeur principal en mettant "HB M" à la place de "BB M", mais ça change rien....
et là, je sèche
 
zeb

zeb

Modérateur
Moi aussi, je sèche :/

Bon, j'ai revisité ton code et le mien.
Et je fais des choses plus propres :
■ Passage d'objet feuille, et non pas par nom de feuille, comme ça, on n'est pas tributaire du classeur.
■ Passage du chemin de sauvegarde.
■ Une seule sauvegarde !

Code: 
' // Enregistre une feuille en lecture seule
Sub Sauve_1(master_sh As Worksheet, path As String)
    Dim new_wb As Workbook
       
    master_sh.Copy
    Set new_wb = ActiveWorkbook
   
    new_wb.Sheets(1).Cells.Locked = True
    new_wb.Sheets(1).Protect Password:="mdp"
    new_wb.Protect Password:="mdp"

    Application.DisplayAlerts = False
    new_wb.SaveAs Filename:=path & "\" & master_sh.Name & "-" & Format(Now, "yyyymmdd" ) & ".xls"
    Application.DisplayAlerts = True
 
    new_wb.Close
   
    Set new_wb = Nothing
    Set master_wb = Nothing
End Sub

Le nouveau Sauve_Plusieurs :
Code: 
Sub Sauve_Plusieurs()
	Dim Chemin As String
	Chemin = ActiveWorkbook.Path
	
	Sauve_1 Worksheets("HB M"), Chemin
	Sauve_1 Worksheets("BB M"), Chemin
	Sauve_1 Worksheets("VB M"), Chemin
End Sub
 
P

philippe81

Habitué
j'étais une fois de plus convaincu par le code
:pt1cable: mais seul le fichier avec la feuille BB M est protégé...
je rectifie, le "BB M" est protégé et les cellules sont inaccessibles
les "HB M" et "VB M" sont protégés mais les cellules sont accessibles....

par contre, ligne 3 tu définis new_wb comme un nouveau classeur de travail
est-il sélectionné automatiquement avant de faire la copie ligne 5?

apparemment c'est la ligne 8 qui ne fait rien pour 2 pages

j'ai essayé en remplaçant les lignes

[cpp]
new_wb.Sheets(1).Cells.Locked = True
new_wb.Sheets(1).Protect Password:="mdp"
[/cpp]
par
[cpp]
new_wb.Sheets(master_sh.name).Cells.Locked = True
new_wb.Sheets(master_sh.name).Protect Password:="mdp"
[/cpp]

ben, ça fait pareil...
 
zeb

zeb

Modérateur
Ligne 3 : Définition d'une variable (en fait un pointeur)
Ligne 5 : Copie de la feuille vers un nouveau classeur qui ne contient que cette feuille + Auto activation du nouveau classeur (relire l'aide de la fonction Copy).
Ligne 6 : On affecte la variable new_wb à ce nouveau classeur. (La nature pointeur de la variable impose l'utilisation de Set.)
Ligne 8 : Plutôt que Sheets(x) on devrait utiliser Worksheets(x) où x est le numéro ou le nom de la feuille.

Nouveau code :
Code: 
' // Enregistre une feuille en lecture seule
Sub Sauve_1(master_sh As Worksheet, path As String)
    Dim new_wb As Workbook

    master_sh.Copy
    Set new_wb = ActiveWorkbook

	new_wb.WorkSheets(1).Name = master_sh.Name
    new_wb.WorkSheets(1).Cells.Locked = True

	Stop

    new_wb.WorkSheets(1).Protect Password:="mdp"

	Stop

    new_wb.Protect Password:="mdp"

	Stop

    Application.DisplayAlerts = False
    new_wb.SaveAs Filename:=path & "\" & master_sh.Name & "-" & Format(Now, "yyyymmdd" ) & ".xls"
    Application.DisplayAlerts = True

    new_wb.Close

    Set new_wb = Nothing
    Set master_wb = Nothing
End Sub
J'ai ajouté, ligne 8, le nommage de la feuille, juste pour faire "pluzoli" :)

Lignes 11, 15, 19, j'ai mis des Stops. Le déroulement de la procédure s'arrêtera à chaque fois, te permettant de vérifier l'état effectif de ton nouveau classeur, de sa feuille et de ses cellules, avant l'enregistrement.

Pour lancer ou relancer le code, touche F5.
Mais ça tu le sais si tu as lu ce
Vous devez être connecté pour voir les liens.
.
 
P

philippe81

Habitué
désolé de te saper le moral, mais ç'est identique:

pour la page "HB M", il coche bien la propriété "verrouillé" des cellules,
effectue la protection mais les propriétés cochées lors de la protection de la feuille ne doivent pas être correct vue que les cellules sont accessibles après mais que la feuille et le classeur sont bien protégé par le mdp

pour la page "BB M", ça fonctionne sans souci

pour la page "VB M", c'est comme pour "HB M"

J'ai l'impression de comprendre le code, mais il ne fait pas ce que j'ai l'impression de lui demander....
 
zeb

zeb

Modérateur
:fou:

Bon alors, résumons, pour la feuille HB :

■ Avant sauvegarde (Au Stop de la ligne 19)
La propriété Verrouillée (Format de cellule/Protection) est cochée pour toutes les cellules ;
La feuille est protégée ;
Le classeur est protégé.

■ Après sauvegarde
La propriété Verrouillée (Format de cellule/Protection) est cochée pour toutes les cellules ;
La feuille est protégée ;
Le classeur est protégé.
Mais on peut modifier le contenu des cellules.

C'est bien ça ?
 
P

philippe81

Habitué
J'ai "trouvé" une solution plus ou moins catholique...

j'ai protégé manuellement les pages du classeur de départ, en décochant donner l'accès au cellules verrouillées, puis j'ai enlevé la protection. Je l'ai pour chaque, et ensuite en faisant tourner la macro, elles sont toutes protégées correctement.

nota: dans les propriétés de protection je pense qu'il fallait décocher manuellement pour chaque feuille 'autoriser l'accès aux cellules verrouillées'. et la propriété est copiée dans chaque nouveau classeur

désolé de t'avoir fait galéré pour presque rien
 
zeb

zeb

Modérateur
Bon, ben t'as trouvé tout seul.
J'aurais voulu que tu me répondes oui, je t'aurais répondu :

Code: 
Sub ZonesLibres(Feuille As Worksheet)
    Dim ZoneLibre As AllowEditRange
    Dim Utilisateur As UserAccess
    Dim s As String
    
    s = "Zones Libres" & vbCrLf
    s = s & "========" & vbCrLf
    s = s & Feuille.Protection.AllowEditRanges.Count & " zone(s) trouvée(s)." & vbCrLf
    
    s = s & "--------------------------------" & vbCrLf
    
    For Each ZoneLibre In Feuille.Protection.AllowEditRanges
        s = s & " • Zone """ & ZoneLibre.Title & """" & vbCrLf
        s = s & "      Adresse: " & ZoneLibre.Range.Address(False, False) & vbCrLf
        s = s & "      Utilisateur: "
        If ZoneLibre.Users.Count = 0 Then
            s = s & "(Aucune précision)"
        Else
            For Each Utilisateur In ZoneLibre.Users
                s = s & Utilisateur & ","
            Next
            s = Left(s, Len(s) - 1)
        End If
        s = s & vbCrLf
                
        s = s & "--------------------------------" & vbCrLf
        
    Next
    
    MsgBox s, , "Zones libres"
End Sub
 
zeb

zeb

Modérateur
Tadaaaaa !!!!!

Code: 
' // Enregistre une feuille en lecture seule
Sub Sauve_1(master_sh As Worksheet, path As String)
    Dim new_wb As Workbook
    Dim ZoneLibre As AllowEditRange

    master_sh.Copy
    Set new_wb = ActiveWorkbook

    For Each ZoneLibre In new_wb.WorkSheets(1).Protection.AllowEditRanges
        ZoneLibre.Delete
    Next
    new_wb.WorkSheets(1).Name = master_sh.Name
    new_wb.WorkSheets(1).Cells.Locked = True
    new_wb.WorkSheets(1).Protect Password:="mdp"
    new_wb.Protect Password:="mdp"

    Application.DisplayAlerts = False
    new_wb.SaveAs Filename:=path & "\" & master_sh.Name & "-" & Format(Now, "yyyymmdd" ) & ".xls"
    Application.DisplayAlerts = True

    new_wb.Close

    Set new_wb = Nothing
    Set master_wb = Nothing
End Sub
 
P

philippe81

Habitué
EUREKA!!!!! il faut utiliser :
[cpp]ActiveSheet.EnableSelection = xlUnlockedCells[/cpp]
et avec tes premières macros ça fonctionne sans problème quand on l'ajoute juste avant la première protection

un grand merci pour le temps que tu as passé à m'aider
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Dernières actus
Derniers messages publiés
Statistiques globales
Discussions
730 134
Messages
6 718 059
Membres
1 586 394
Dernier membre
Manoushk
Partager cette page
Haut