Bonjour,
Dans nos planning Généraux nous avons, pour chaque feuille, une macro explicite faisant référence à un fichier excel
qui nous permet d'affecter automatiquement une mise en forme à chaque cellule d'une plage en fonction de la valeur saisie.
Ces fichiers se trouvent sur un serveur NAS et chaque utilisateur accède à ces fichiers via un lecteur réseau.
Dans cette Macro, le chemin du fichier2 "coloris-animateurs.xlsx" est indiqué sous la forme
Lettre du lecteur réseau:\chemin du fichier\nom du fichier
ce qui oblique chaque utilisateur a avoir la même lettre pour ce lecteur réseau.
Existe t'il un moyen de s'affranchir de cette lettre de lecteur. car chaque utilisateur possède plusieurs lecteurs réseaux et pour unifier une lettre, il faudrait recréer chaque lecteur en choisissant une lettre qui est dispo chez chacun.
Merci par avance.
Voici la macro:
Dans nos planning Généraux nous avons, pour chaque feuille, une macro explicite faisant référence à un fichier excel
qui nous permet d'affecter automatiquement une mise en forme à chaque cellule d'une plage en fonction de la valeur saisie.
Ces fichiers se trouvent sur un serveur NAS et chaque utilisateur accède à ces fichiers via un lecteur réseau.
Dans cette Macro, le chemin du fichier2 "coloris-animateurs.xlsx" est indiqué sous la forme
Lettre du lecteur réseau:\chemin du fichier\nom du fichier
ce qui oblique chaque utilisateur a avoir la même lettre pour ce lecteur réseau.
Existe t'il un moyen de s'affranchir de cette lettre de lecteur. car chaque utilisateur possède plusieurs lecteurs réseaux et pour unifier une lettre, il faudrait recréer chaque lecteur en choisissant une lettre qui est dispo chez chacun.
Merci par avance.
Voici la macro:
Code:
Option Explicit
Dim fplage As Range, cel As Range
Dim estouvert As Byte
Dim Chemin As String, fichier1 As String, fichier2 As String
Dim fich As Workbook
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
'****************************************************************************************************************
' Consulter la gestion des erreurs en cas d'erreur et renvoyer le message associé (voir en fin de macro)*********
'****************************************************************************************************************
On Error GoTo gestion_erreur
'****************************************************************************************************************
'****************************************************************************************************************
Chemin = ThisWorkbook.Path 'chemin du fichier actuel
fichier1 = ThisWorkbook.Name 'nom du fichier actuel
fichier2 = "U:\RH\Coloris-Animateurs.xlsx" 'chemin du fichier "Coloris-Animateurs.xlsx"[/COLOR]
'****************************************************************************************************************
' Contrôler si le classeur "Coloris-Animateurs" est ouvert ******************************************************
'****************************************************************************************************************
estouvert = 0 'donner la valeur 0 à cette variable
For Each fich In Workbooks
If fich.Name = "Coloris-Animateurs.xlsx" Then estouvert = 1 'passer à 1 si le fichier est ouvert
Next
If estouvert = 0 Then Workbooks.Open (fichier2) 's'il n'est pas ouvert, on l'ouvre et on l'active
Windows("Coloris-Animateurs.xlsx").Activate
Set fplage = Sheets(1).Range("A2:A" & Sheets(1).Range("A1").End(xlDown).Row) 'plage de recherche
Windows(fichier1).Activate 'on revient sur le premier classeur
'****************************************************************************************************************
'****************************************************************************************************************
If Not Intersect(Target, Range("C11:BB41")) Is Nothing Then 'plage modifiable :cellule C41 à BB41
For Each cel In Intersect(Target, Range("C11:BB41"))
If cel = "" Then
cel.Interior.ColorIndex = xlNone
cel.Font.ColorIndex = xlAutomatic
ElseIf cel <> "" Then
cel.Interior.Color = fplage.Find(Target.Value, , LookIn:=xlValues, lookat:=xlWhole).Interior.Color
cel.Font.Color = fplage.Find(Target.Value, , LookIn:=xlValues, lookat:=xlWhole).Font.Color
End If
Next cel
End If
Application.DisplayAlerts = False 'désactiver les alertes
Workbooks("Coloris-Animateurs.xlsx").Save 'on sauvegarde les dernières modifications du classeur "Coloris-Animateurs"
Workbooks("Coloris-Animateurs.xlsx").Close
Application.DisplayAlerts = True 'réactiver les alertes
'****************************************************************************************************************
' Gestion des erreurs *******************************************************************************************
'****************************************************************************************************************
gestion_erreur:
If Err.Number = 91 Then
MsgBox "Le nom introduit n'existe pas dans la liste Coloris-Animateurs " & chr(13) & chr(13) & _
"Allez sur le classeur Coloris-Animateurs et ajoutez le nom." & chr(13) & _
"Revenez sur le planning et réintroduisez le nouveau nom." _
, vbExclamation, "Nom absent de la liste Coloris-Animateurs"
End If
'****************************************************************************************************************
'****************************************************************************************************************
Application.ScreenUpdating = True
End Sub