Message Box

[solide84]

Bonjour à tous

Je souhaiterai ajouter un message box "sauvegarde déjà effectuer' afin d'éviter d'avoir une erreur d'exécution 1004 .

Détail de mon code création d'une nouvelle feuille renommer avec le numéro de la semaine.

mon objectif si la feuille renommer de la semaine à déjà été créer message sauvegarde déjà effectuer.

voici mon code


Sub Macro1()
'
' Macro1 Macro
'
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Format(Date, "WW")
Dim varTexte As String
varTexte = "Sauvegarde Semaine Ok"
MsgBox varTexte

End Sub

 

[Roland_M]

bonjour ,

qq chose comme ça !?

Sub Macro1()
On Error Resume Next
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Format(Date, "WW")
If Err Then
   MsgBox "Sauvegarde déjà effectuée !?", vbExclamation, ""
Else
   MsgBox "Sauvegarde Semaine Ok", vbInformation
End if
On Error GoTo 0: Err.Clear
End Sub

 

[solide84]

Impeccable merci beaucoup

 

[solide84]

Arfff j'arrive pas a le mettre dans mon code global

Peux tu me l'ajouter ou il faut. J'ai un problème de double end

Sub Sauvegarde_Semaine()

'
' Sauvegarde_Semaine Macro
'

Sheets("Bdd Redmine").Select

Cells.Select
Selection.Copy


Workbooks.Open Filename:="C:\Users\e_rherbo\Desktop\Support Indicateur\Bdd Historique semaine.xlsm.xlsx"


On Error Resume Next
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Format(Date, "WW")
If Err Then
MsgBox "Sauvegarde déjà effectuée !?", vbExclamation, ""
End If
On Error GoTo 0: Err.Clear
End Sub

Range("A1").Select
ActiveSheet.Paste

ActiveSheet.ListObjects("Bdd_Extraction_redmine_2").TableStyle = _
"TableStyleMedium3"


ActiveWorkbook.Connections("Requête - Bdd Extraction redmine").Delete

Sheets("Transformation").Select

Range("A1").Select
ActiveSheet.Paste

Columns("R:U").Select
Selection.Delete Shift:=xlToLeft
Columns("L:M").Select
Selection.Delete Shift:=xlToLeft
Columns("D:J").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft

Columns("B:B").Select
Columns(2).Insert
ActiveCell.FormulaR1C1 = "Statut N°Semaine"
Range("B2").Select
Columns("B:B").EntireColumn.AutoFit
Range("B2").Select
ActiveCell.FormulaR1C1 = "=WEEKNUM(TODAY())"

Columns("G:G").Select
Selection.Delete Shift:=xlToLeft

Application.ScreenUpdating = False
fin = ActiveSheet.UsedRange.Rows.Count
For i = fin To 2 Step -1
If (Range("B" & i) <> Range("G" & i)) And Range("C" & i) = "Résolu" Then Rows(i).Delete Shift:=xlUp
Next i
Application.ScreenUpdating = True

ActiveWorkbook.Connections("Requête - Bdd Extraction redmine").Delete

Range("Bdd_Extraction_redmine_211").Select
Selection.Copy
Sheets("Bdd_Redmine_Semaine").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Range("B8").Select
ActiveWindow.SmallScroll Down:=-9

Sheets("Transformation").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select

ActiveWorkbook.Save

Windows("RED_ENGINE V4.4.xlsm").Activate

Sheets("Bdd_redmine_Semaine").Select

End Sub

'

 

[Roland_M]

re

ben je sais pas trop le déroulement de l'affaire mais ...

ici, que fait là le End Sub ?
--------------
On Error Resume Next
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Format(Date, "WW")
If Err Then
MsgBox "Sauvegarde déjà effectuée !?", vbExclamation, ""
End If
On Error GoTo 0: Err.Clear
End Sub '<<<<<<<<<<< !? il ne faut pas !
---------------------

tu veux sortir de la macro si déjà effectué, je suppose !?
alors remplacer tout ça par ceci:

On Error Resume Next
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Format(Date, "WW")
If Err Then MsgBox "Sauvegarde déjà effectuée !?", vbExclamation, "": Exit Sub
On Error GoTo 0: Err.Clear
et suite de ton code

 

[solide84]

ouai je voulais sortir de la macro si erreur. Merci beaucoup

 

[solide84]

Fonctionne du tonnerre Merci