Probléme à lenregistrement
Bonsoir le forum
Un petit souci avec une macro que j'utilise régulièrement, qui fonctionne très bien, mais il y a un "hic"!!!
Ma macro créer une nouvelle semaine de travail sous le nom semaine ... 50 par exemple .
Le problème c'est que lon est à quatre à utilisé ce classeur. Donc lorsque je créer la nouvelle semaine et qu'un collègue passe derrière et veux créer la même semaine 50, forcement il écrase la mienne!!!
En utilisant ma base serait il possible qu' elle regarde si la semaine existe déjà.
je vous la colle ci dessous.
Sub Sauvegarde_agent_001()
'
' Sauvegarde_agent_001 Macro
'
Sheets("001").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Accueil ").Select
Application.DisplayAlerts = False
ChDir "M:\DOP DT\Bases Techniques Chauffage\COMPTEUR HORAIRE AGENTS\Semainier divers groupes\Neuhof\2013"
ActiveWorkbook.SaveAs Filename:= _
"M:\DOP DT\Bases Techniques Chauffage\COMPTEUR HORAIRE AGENTS\Semainier divers groupes\Neuhof\2013\Semaine " & Range("C7").Value & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
MsgBox "Le dossier est sauvegardé !"
Application.DisplayAlerts = True
End Sub
Merci à tous le forum.
Bonsoir à tous j'ai trouvé la solution,
Je la dépose pour celui qui en a besoin.
Sub New_semaine_.....()
'
' New_semaine_......
'
'
Application.DisplayAlerts = False 'il désactive les messages d'alerte
Dim Rep As String
Rep = "M:\.....\2014"
Dim Fich As String
Fich = "Semaine " & Range("C18").Value & ".xlsm"
If Dir(Rep & "\" & Fich, vbDirectory) <> "" Then
'Si la semaine existe
Select Case MsgBox("La semaine existe veux tu l'ouvrir?", 16 + vbYesNoCancel + vbDefaultButton3, "Product")
Case vbYes
If Dir(Rep & "\" & Fich, vbDirectory) <> "" Then
Workbooks.Open Filename:=(Rep & "\" & Fich)
Else
MsgBox "Chemin introuvable"
End If
Exit Sub ' On quitte le programme
Case vbNo
Exit Sub ' On quitte le programme
Case Else
' Sortie du programme
Exit Sub
End Select
'Si la semaine n'existe pas
Else
'Il a créer
ChDir (Rep)
ActiveWorkbook.SaveAs Filename:=Rep & "\" & Fich
MsgBox "La nouvelle semaine est crée." & vbCrLf & "Le classeur sera fermé aprés le clic sur OK."
Range("C16:E16").Select
Sheets("Accueil ").Visible = True
Sheets("NS").Select
ActiveWindow.SelectedSheets.Visible = False
End If
ActiveWorkbook.Save 'Il sauve
Application.DisplayAlerts = True 'il réactive les message d'alerte
Application.Quit 'et il quit
End Sub