XL 2013 Regroupement de deux macros.

[sarf]

Bonjour,

j'ai deux macro qui fonctionnent séparément, mais je n'arrive pas a lés assembler.
Une première pour valider des feuilles et une deuxième pour empêcher toute sauvegarde du fichier.

N°1:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("I15")) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False

If Target.Value = "¨" Then
For i = 2 To 6
Sheets(i).Visible = -1
Next i
Target.Offset(0, 1) = "Validez en cliquant sur le bouton rouge "
Target.Value = "þ"
Application.EnableEvents = True
Target.Offset(9, 1).Select
Exit Sub
Else
Application.EnableEvents = False
For i = 2 To 6
Sheets(i).Visible = 2
Next i
Target.Offset(0, 1) = "Validez en cliquant sur le bouton rouge "
Target.Value = "¨"
Cells(9, 1).Select
End If
End If

fin:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub



N°2:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI = False Then
MsgBox "Veuillez ""enregistrer sous"" et utiliser un nouveau nom"
Cancel = True
Else
MsgBox "Veuillez utiliser un nouveau nom"
End If
End Sub


Merci de votre aide

pierre

 

[Lone-wolf]

Re : Regroupement de deux macros.

Bonsoir Pierre

Voici le code corrigé. Pour rappel: Application.EnableEvents est à mettre quand tu utilise l'évènement Worksheet_Change(); et c'est False en début de macro et True en fin de macro, et non en doublon comme tu l'a fait.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("I15")) Is Nothing Then
If Target.Value = "¨" Then
For i = 2 To 6
Sheets(i).Visible = -1
Next i
Target.Offset(0, 1) = "Validez en cliquant sur le bouton rouge "
Target.Value = "þ"
Target.Offset(9, 1).Select
Exit Sub
Else
For i = 2 To 6
Sheets(i).Visible = 2
Next i
Target.Offset(0, 1) = "Validez en cliquant sur le bouton rouge "
Target.Value = "¨"
Cells(9, 1).Select
End If
End If
End Sub

En ce qui concerne ta deuxième demande, enregistrer sans sauvegarder. Mais je ne comprend pas pourquoi le message "veuillez enregistrer sous un autre nom", alors que tu veux l'en empêcher.??

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
    Cancel = SaveAsUI 
End Sub 

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.Quit
End Sub

 

[sarf]

Re : Regroupement de deux macros.

Bonjour,

Merci de ta réponse.

Si je mets les deux macro l'une a la suite, cela fonctionne?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("I15")) Is Nothing Then
If Target.Value = "¨" Then
For i = 2 To 6
Sheets(i).Visible = -1
Next i
Target.Offset(0, 1) = "Validez en cliquant sur le bouton rouge "
Target.Value = "þ"
Target.Offset(9, 1).Select
Exit Sub
Else
For i = 2 To 6
Sheets(i).Visible = 2
Next i
Target.Offset(0, 1) = "Validez en cliquant sur le bouton rouge "
Target.Value = "¨"
Cells(9, 1).Select
End If
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = SaveAsUI
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.Quit
End Sub

Comme cela?

Je ne veux pas qu'une personne puisse écraser le fichier d'origine, juste faire une autre sauvegarde (une version 2)

Merci

Pierre

 

[sarf]

Re : Regroupement de deux macros.

Bonjour,

Merci de votre réponse.

Si je mets les deux macro l'une a la suite de l'autre cela fonctionne?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("I15")) Is Nothing Then
If Target.Value = "¨" Then
For i = 2 To 6
Sheets(i).Visible = -1
Next i
Target.Offset(0, 1) = "Validez en cliquant sur le bouton rouge "
Target.Value = "þ"
Target.Offset(9, 1).Select
Exit Sub
Else
For i = 2 To 6
Sheets(i).Visible = 2
Next i
Target.Offset(0, 1) = "Validez en cliquant sur le bouton rouge "
Target.Value = "¨"
Cells(9, 1).Select
End If
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = SaveAsUI
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.Quit
End Sub


Je veux éviter qu'une personne écrase le fichier, juste qu'il puisse créer une version 2

Merci de votre retour

Pierre