partager une macro excel

[Lozada]

Je désire savoir comment je peux partager un fichier en réseau, avec plusieur utilisateurs,mon classeur contient des macros.
merci

 

[DJN90]

Bsr Lozada,

Il ya une option que tu peux choisir dans le menu :

menu "outils" -> "partager du classeur..." -> onglet modification - cocher la case "permettre ......"

Dans onglet "avancé" choisir les options que tu désires

Dans "outils" -> "afficher les modifications" choisir les options après avoir coché la case "suivre modifications ..."

NB : s'il faut des mots de passe pour chaque user, il faudra les mettre dans ta macro.

fait savoir tes commentaires au forum.

Dan

 

[DJN90]

Bjr Lozada,

Sorry mais j'ai omis de te dire que si la partage de ton fichier ne concerne que l'aspect consultation par plusieurs personnes , tu peux utiliser l'option "lecture recommandée seule que tu trouveras dans menu fichier -> enregistrer sous -> bouton "options d'enregistrement" click sur case à cocher "lecture seule recommandée"
Tu peux également ajouter des mots de passe pour la protection et l'accès en écriture.

Espérant t'avoir aidé

Bonne journée

Dan

 

[fermo]

Bonsoir à tous et forum,


grace à l'option recherche, j'ai trouvé un fil qui parle du partage, mais quand je fais tout ce que Dan explique, j'ai des problèmes dans mes macros, enfin elles ne fonctionnent pas correctements.

Avez vous déjà eu ce genre de problème, pouvez vous m'aider ?


Mervi d'avance Fermo

 

[Dan]

Salut Fermo,

Ben tiens voilà une de mes premières interventions sur XLD. Je ne m'en rappelais plus.

Bon ton pb, pourrais-tu être plus explicite car je ne comprends pas bien pourquoi tes macros ne fonctionneraient pas lorsque tu utilises les options de partage.
Que se passe - t - il avec tes macros ?

@+

Dan

 

[fermo]

Voilà, dès que je partage par outils etc, je ne peux plus faire aller correctement le programme, soit, ça ne vide pas toutes les cellules comme ci desous en exemple, ou une condition bloque à la 2ème macro ?

et dès que départage le classeur ça fonctionne ?

As tu une idée... merci pour ta réponse Fermo


Sub Vider2()
On Error Resume Next
Application.Run "Z_Bloque"
Sheets("Bulletin de livraison").Select

Application.ScreenUpdating = False
'Demander un choix avant de lancer la macro
votreRéponse = MsgBox("Est-ce que vous voulez vraiment effacer le Bulletin de Livraison ?" _
& (Chr(13)), vbYesNo, "Attention! © Fermo Bonadei août 2003")
If votreRéponse = vbNo Then
Exit Sub
End If



ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules

Range("a3").Select
Selection.ClearContents
Range("c19:c29").Select
Selection.ClearContents
Range("b33:b39").Select
Selection.ClearContents
Range("g33:g39").Select
Selection.ClearContents
Range("r33:r39").Select
Selection.ClearContents
Range("s33:s39").Select
Selection.ClearContents
Range("c41").Select
Selection.ClearContents

Range("A15").Select
Range("c18").Select
ActiveCell.FormulaR1C1 = "=TODAY()"



Range("a31").Select 'Copie la formule pour combler les entrées manuelles
Selection.Copy
Range("a33:a39").Select ' colle la formule pour combler les entrées manuelles
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False




Range("c31:c31").Select 'Copie la formule pour combler les entrées manuelles
Selection.Copy
Range("c33:c39").Select ' colle la formule pour combler les entrées manuelles
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("i31:j31").Select 'Copie la formule pour combler les entrées manuelles
Selection.Copy
Range("i33:j39").Select ' colle la formule pour combler les entrées manuelles
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("y33:y39").Select 'Copie la formule pour combler les entrées manuelles
Selection.Copy
Range("a33:a39").Select ' colle la formule pour combler les entrées manuelles
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("b41").Select 'Copie la formule pour combler les entrées manuelles
Selection.Copy
Range("c41").Select ' colle la formule pour combler les entrées manuelles
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False


Range("a44").Select 'Copie la formule pour combler les entrées manuelles
Selection.Copy
Range("a45").Select ' colle la formule pour combler les entrées manuelles
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

With Application
.Calculation = xlAutomatic ' mais OPTION sur calcul automatique, car elle ce déclenche parfois
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False

Sheets("Bulletin de livraison").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules


ActiveSheet.Protect Password:="3789"
ActiveSheet.EnableSelection = xlUnlockedCells 'protège les cellules

Range("c18").Select

End Sub

*****************************************



Sub Livrtoarchive()
On Error Resume Next
Application.ScreenUpdating = False



ContrôleBlt

'Conditions contrôle si le bulletin est archivé
'Sur Blt livraison
If Range("controlearchives") = "1" Then
MsgBox "IMPOSSIBLE, le Bulletin est déjà Archivé!."
Range("controlearchives").Select
Exit Sub
End If

'Conditions Validation
'Sur Date
If Range("Date") = "" Then
MsgBox "Date du Document non renseignée."
Range("Date").Select
Exit Sub
End If

'Sur N°
If Range("Nclient") = "" Then
MsgBox "Numéro client non renseigné."
Range("Nclient").Select
Exit Sub
End If

'Sur Réf
If Range("Réf") = "" Then
MsgBox "Référence non renseigné."
Range("Réf").Select
Exit Sub
End If

'Sur adresse
If Range("c26") = "" Then
MsgBox "Adresse non renseigné."
Range("c26").Select
Exit Sub
End If

'Sur N° Article
If Range("b33") = "" Then
MsgBox "Qté Article non renseigné."
Range("b33").Select
Exit Sub
End If

'Sur Qté Article
If Range("g33") = "" Then
MsgBox "N° Article non renseigné."
Range("g33").Select
Exit Sub
End If

'Sur Nom du collaborateur stratex
If Range("Nomcollaborateurs") = "" Then
MsgBox "Nom du collaborateur stratex, non renseignée."
Range("Nomcollaborateurs").Select
Exit Sub
End If


Sheets("Archive livraison").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules

Sheets("Bulletin de livraison").Activate 'affiche 1 pour repert si facture archivée
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules
Range("controlearchives") = 1

Sheets("Archive livraison").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules
Rows("3:3").Select
'Application.CutCopyMode = False
Selection.Copy
ActiveCell.SpecialCells(xlLastCell).Select
Cells(ActiveCell.Row + 1, 1).Select 'se place à gauche
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Va vider tous les "0"
ActiveCell.Offset(0, 0).Range("A1").Select
For i = 1 To 120
If ActiveCell = "0" Then
Selection.ClearContents
Else
End If
ActiveCell.Offset(0, 1).Range("A1").Select
Next i



'Imprimer Document
'Nbre de copie à imprimer
vNbreImp = InputBox("Nombre d'exemplaire à imprimer :", "Impression Document", 1)
If vNbreImp <= 0 Then GoTo 5
If IsNumeric(vNbreImp) Then
GoTo 10
Else: Do Until IsNumeric(vNbreImp)
5
MsgBox "La valeur doit être un nombre entier et > 0"
vNbreImp = InputBox("Nombre d'exemplaire à imprimer :", "Impression Document", 1)
Loop
GoTo 10
End If
10
Sheets("Bulletin de livraison").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=vNbreImp
GoTo 20

20
Sheets("Bulletin de livraison").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules
Sheets("Bulletin de livraison").Activate


Sheets("Informations Société").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules



'Incrémentation Compteur
Range("vnDocumentNumDoc") = Range("vnDossierNumDoc")




Sheets("Archive livraison").Select
ActiveSheet.Protect Password:="3789"
ActiveSheet.EnableSelection = xlNoRestrictions 'protège les cellules

Sheets("Archive livraison").Select
triéBlt

Sheets("Articles").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, Password:="3789"

Sheets("Bulletin de livraison").Select
ActiveSheet.Protect Password:="3789"
Range("a15").Select


End Sub

 

[Fermo]

Bonjours Dan et tout le Forum,


Je reviens à charge pour mon problème de partage multi utilisateurs.


Dois je mettre une formule magique dans mes macros ?

Dois je protéger mon classeur, ou autre choses ?


Pouvez vous m'aider , car cela fait des semaines que je patine ... et en plus il neige...


Au plaisir de vous lire, amicalement Fermo

 

[Fermo]

Bonjours à tous et Forum,


j'ai fais le pratage comme expliqué par plusieurs personnes du Forum et actuellement, je rencontre des problèmes avec mes macros, j'ai mis un exemple:

Pouvez vous me dire ce qui n'est pas compatible avec le partage ou de faux dans la macro ?


Merci pour votre aide Fermo



Sub OffreToArchive() 'C021215CR
On Error Resume Next
Application.ScreenUpdating = False

Sheets("Offre").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules

ControleOff

'Conditions contrôle si l'offre est archivée
'Sur Offre
If Range("ControleOffre") = "1" Then
MsgBox "IMPOSSIBLE, l'offre est déjà Archivée!."
Range("ControleOffre").Select
Exit Sub
End If

'Sur Date
If Range("DateOffre") = "" Then
MsgBox "Date du Document non renseignée."
Range("DateOffre").Select
Exit Sub
End If


'Sur N°
If Range("NclientOffre") = "" Then
MsgBox "Numéro client non renseigné."
Range("NclientOffre").Select
Exit Sub
End If

'Sur N°
If Range("RefOffre") = "" Then
MsgBox "Référence offre non renseigné."
Range("RefOffre").Select
Exit Sub
End If

'Sur N° Article
If Range("ArticleOffre") = "" Then
MsgBox "N° Article non renseigné."
Range("ArticleOffre").Select
Exit Sub
End If

'Sur prix unitaire 1
If Range("PrixOffre") = "0" Then
MsgBox "Prix unitaire non renseigné."
Range("PrixOffre").Select
Exit Sub
End If

'Sur Nom du collaborateur stratex
If Range("NomCollaborateurOffre") = "" Then
MsgBox "Nom du collaborateur stratex, non renseignée."
Range("NomCollaborateurOffre").Select
Exit Sub
End If

'Sur Nom du collaborateur stratex
If Range("NomCollaborateurOffre") = "0" Then
MsgBox "Nom du collaborateur stratex, non renseignée."
Range("NomCollaborateurOffre").Select
Exit Sub
End If


Sheets("Archive Offre").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules

Sheets("Offre").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules

Rows("3:3").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.SpecialCells(xlLastCell).Select
Cells(ActiveCell.Row + 1, 1).Select 'se place à gauche
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Va vider tous les "0"
ActiveCell.Offset(0, 0).Range("A1").Select
For i = 1 To 120
If ActiveCell = "0" Then
Selection.ClearContents
Else
End If
ActiveCell.Offset(0, 1).Range("A1").Select
Next i


'Imprimer Document
'Nbre de copie à imprimer
vNbreImp = InputBox("Nombre d'exemplaire à imprimer :", "Impression Document", 1)
If vNbreImp <= 0 Then GoTo 5
If IsNumeric(vNbreImp) Then
GoTo 10
Else: Do Until IsNumeric(vNbreImp)
5
MsgBox "La valeur doit être un nombre entier et > 0"
vNbreImp = InputBox("Nombre d'exemplaire à imprimer :", "Impression Document", 1)
Loop
GoTo 10
End If
10
Sheets("Offre").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=vNbreImp
GoTo 20

20

Sheets("Offre").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules
Sheets("Offre").Activate


Sheets("Informations Société").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules

'Incrémentation Compteur
Range("NuméroDocOffre") = Range("vnDossierNumOffre") ' test

'*********************

Sheets("Offre").Select
Sheets("Offre").Activate 'affiche 1 pour repert si Offre archivée
Range("controlearchive") = 1

Sheets("Offre").Activate 'affiche 1 pour repert si Offre vidée
Range("controlevideroffre") = 1


Sheets("Archive Offre").Select
triéBlt
ActiveSheet.Protect Password:="3789"
ActiveSheet.EnableSelection = xlNoRestrictions 'protège les cellules



Sheets("Articles").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, Password:="3789"



Sheets("Offre").Select
ActiveSheet.Protect Password:="3789"
ActiveSheet.EnableSelection = xlUnlockedCells 'protège les cellules



Sheets("Offre").Select
Range("a15").Select
MsgBox "L'offre est archivée !", vbOKOnly + vbInformation, "TRANSFERT DE DONNÉES © 2003 "
End Sub