Cedrim69
XLDnaute Nouveau
Bonjour,
J'ai écris (avec l'aide de membres du forum) un code pour générer un fichier à partir d'une template. Mais le code écrase sans demander de confirmation si le fichier existe déjà.
Je souhaite également verifier que le fichier que je vais créé n'existe pas dans tous les dossiers qui sont dans le répertoire de mon gabarit (voir image)
J'ai testé le code suivant, mais celà ne fonctionne pas :
Est-ce que quelqu'un pourrait m'aider ?
Cordialement,
Cédric
J'ai écris (avec l'aide de membres du forum) un code pour générer un fichier à partir d'une template. Mais le code écrase sans demander de confirmation si le fichier existe déjà.
Je souhaite également verifier que le fichier que je vais créé n'existe pas dans tous les dossiers qui sont dans le répertoire de mon gabarit (voir image)
J'ai testé le code suivant, mais celà ne fonctionne pas :
VB:
Sub Sauvegarder()
''''''''''''''''''''''''''''''''''''''''''''''''''''''
'SELECTION DU REPERTOIRE DE SAUVEGARDE
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim sRep As String, sName As String, sDir As String, N As Name
Dim F As Worksheet
Set F = ThisWorkbook.Sheets("Chart")
sDir = ThisWorkbook.Path
sName = F.Range("B2")
If F.Range("B5") = "NO" Then
sRep = "03 - Non conformités non avérées"
ElseIf F.Range("B5") = "YES" Then
If F.Range("D3") = "" Then
sRep = "01 - Non coformités réelles non corrigées"
Else
sRep = "02 - Non conformités réelles corrigées"
End If
Else
MsgBox "Problem with saving directory : " & vbCr & sRep
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''
'VERIFICATION DU REMPLISSAGE
''''''''''''''''''''''''''''''''''''''''''''''''''''''
mMissing = ""
mSpare = ""
If Chart.Range("B5") = "YES" Then
'INFO GENERAL
'Infos manquantes
If Chart.Range("B2") = "" Then mMissing = mMissing & "- Case number" & vbLf
If Chart.Range("B3") = "" Then mMissing = mMissing & "- Name" & vbLf
If Chart.Range("B5") = "" Then mMissing = mMissing & "- Non-conformity doc confirmation" & vbLf
If Chart.Range("D2") = "" Then mMissing = mMissing & "- Date" & vbLf
'INFO VEHICULE
'Infos manquantes
If Chart.Range("B7") = "" Then mMissing = mMissing & "- Catalogue concerned" & vbLf
If Chart.Range("B8") = "" Then mMissing = mMissing & "- Truck range" & vbLf
If Chart.Range("D7") = "" Then mMissing = mMissing & "- Standard concerned" & vbLf
If Chart.Range("D9") = "" Then mMissing = mMissing & "- Time Estimated for correction" & vbLf
'INFO DOC
'Infos manquantes
If Chart.Range("D11") = "" Then mMissing = mMissing & "- Doc Not Correct : Supposed Root Cause" & vbLf
If Chart.Range("D12") = "" Then mMissing = mMissing & "- Doc Not Correct : Aim of the request" & vbLf
'Infos en trop
If Chart.Range("B11") <> "" Then mSpare = mSpare & "- Doc Correct : Supposed Root Cause" & vbLf
If Chart.Range("B12") <> "" Then mSpare = mSpare & "- Doc Correct : Aim of the request" & vbLf
End If
If Chart.Range("B5") = "NO" Then
'INFO GENERAL
'Infos manquantes
If Chart.Range("B2") = "" Then mMissing = mMissing & "- Case number" & vbLf
If Chart.Range("B3") = "" Then mMissing = mMissing & "- Name" & vbLf
If Chart.Range("B5") = "" Then mMissing = mMissing & "- Non-conformity confirmation" & vbLf
If Chart.Range("D2") = "" Then mMissing = mMissing & "- Date" & vbLf
'INFO VEHICULE
'Infos manquantes
If Chart.Range("B7") = "" Then mMissing = mMissing & "- Catalogue concerned" & vbLf
If Chart.Range("B8") = "" Then mMissing = mMissing & "- Truck range" & vbLf
If Chart.Range("D7") = "" Then mMissing = mMissing & "- Standard concerned" & vbLf
If Chart.Range("D9") = "" Then mMissing = mMissing & "- Time Estimated for correction" & vbLf
'INFO DOC
'Infos manquantes
If Chart.Range("B11") = "" Then mMissing = mMissing & "- Supposed Root Cause" & vbLf
If Chart.Range("B12") = "" Then mMissing = mMissing & "- Aim of the request" & vbLf
'Infos en trop
If Chart.Range("D11") <> "" Then mSpare = mSpare & "- Supposed Root Cause" & vbLf
If Chart.Range("D12") <> "" Then mSpare = mSpare & "- Aim of the request" & vbLf
End If
'AFFICHAGE
If mMissing <> "" Then
MsgBox "Your sheet is missing the following :" & vbLf & mMissing & vbLf & "Save Cancelled" & vbCr & "Please complete informations", vbExclamation, "Avertissement"
Exit Sub
End If
If mSpare <> "" Then
MsgBox "Unneeded information in the sheet :" & vbLf & mSpare & vbLf & "Save Cancelled" & vbCr & "Please complete informations", vbExclamation, "Avertissement"
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Verification existance de la fiche
''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Dir(sDir & "/01 - Non coformités réelles non corrigées/" & sName & ".xlsx", vbNormal) = True Then
Select Case MsgBox("Chart # : " & sName & " already exists in the directory 01 - Non coformités réelles non corrigées" & vbLf & "Do you want to continue?", vbOKCancel + vbInformation)
Case vbOK
'Ne rien faire
Case vbCancel
Exit Sub
End Select
ElseIf Dir(sDir & "/02 - Non conformités réelles corrigées/" & sName & ".xlsx", vbNormal) = True Then
Select Case MsgBox("Chart # : " & sName & " already exists in the directory 02 - Non conformités réelles corrigées" & vbLf & "Do you want to continue?", vbOKCancel + vbInformation)
Case vbOK
'Ne rien faire
Case vbCancel
Exit Sub
End Select
ElseIf Dir(sDir & "/03 - Non conformités non avérées/" & sName & ".xlsx", vbNormal) = True Then
Select Case MsgBox("Chart # : " & sName & " already exists in the directory 03 - Non conformités non avérées" & vbLf & "Do you want to continue?", vbOKCancel + vbInformation)
Case vbOK
'Ne rien faire
Case vbCancel
Exit Sub
End Select
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''
'SAUVEGARDE
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Select Case MsgBox("Chart # : " & sName & vbLf & "will be saved in : " & vbLf & _
sRep, vbOKCancel + vbInformation)
Case vbOK
F.Copy
With ActiveWorkbook
For Each N In .Names
N.Delete
Next N
.ActiveSheet.Range("A1:D12").Validation.Delete
.SaveAs sDir & "/" & sRep & "/" & sName & ".xlsx", xlOpenXMLWorkbook
.Close
End With
MsgBox "Chart # : " & sName & vbCr & "was saved in :" & vbCr & sRep
Windows("Argus NC Chart.xlsm").Activate
Sheets("Chart").Range("B2:B5,D2:D4,B7:B9,D7:D9,B11:B12,D11:D12").ClearContents
Case vbCancel
MsgBox "Save Canceled"
End Select
End Sub
Est-ce que quelqu'un pourrait m'aider ?
Cordialement,
Cédric