Re : Debugging en amont de la première instruction du VBA dans la macro auto_open
Bonjour,
OK Je comprends votre réticence.
Voici donc mon code.
Merci
' Code de la feuil1 "rando " ===========================================================================================
Public zhdepart As String
Public zftest As String
Public zsaf As String
Public zdenivp As String
Public zdenivn As String
Public zdenivs As String
Public zdenivx As String
'Private Sub Calendar1_Click()
'ActiveSheet.Unprotect ("dc3618")
Private Sub Worksheet_Change(ByVal Target As Range)
If zftest = "" Then zftest = "non"
If indic_open = "1" Then
Else
If nom_feuil = "" Then '2016 si la macro auto_open n'a pas été exécutée
' suite à un souci de protection ou emplacements non autorisés (lors du premier accès)
' alors l'éxécuter maintenant pour rattraper la situation
auto_open '2016
End If '2016
If Target.Address = "$B$5" Or Target.Address = "$B$5:$F$5" Then 'NOM
ctl_nom
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$B$6" Or Target.Address = "$B$6:$F$6" Then 'date
ActiveSheet.Unprotect ("dc3618")
ctl_date
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
'
If Range("b6") < Range("A125") Then
wtxt1 = "La date de la randonnée saisie ("
wtxt2 = ") est antérieure à la date minimale admise ("
wtxt3 = "). Confirmez-vous cette date de randonnée ("
wtxt4 = ")? REPONDEZ PAR OUI ou PAR TOUT AUTRE REPONSE QUI SERA CONSIDEREE COMME = NON puis presser le bouton OK-"
wtxt0 = wtxt1 & Range("b6") & wtxt2 & Range("A125") & wtxt3 & Range("b6") & wtxt4
xtext3 = "DATE DE LA RANDONNEE (<limite inférieure) "
wrep1 = InputBox(wtxt0)
If wrep1 = "OUI" Or wrep1 = "oui" Or wrep1 = "Oui" Or wrep1 = "o" Or wrep1 = "O" Then
Else
err_zone = 1
Exit Sub
End If
Else
If Range("b6") > Range("C125") Then
wtxt1 = "La date de la randonnée saisie ("
wtxt2 = ") est postérieure à la date maximale admise ("
wtxt3 = "). Confirmez-vous cette date de randonnée ("
wtxt4 = ")? REPONDEZ PAR OUI ou PAR TOUT AUTRE REPONSE QUI SERA CONSIDEREE COMME = NON puis presser le bouton OK-"
wtxt0 = wtxt1 & Range("b6") & wtxt2 & Range("C125") & wtxt3 & Range("b6") & wtxt4
xtext3 = "DATE DE LA RANDONNEE (> limite supérieure)"
wrep1 = InputBox(wtxt0)
If wrep1 = "OUI" Or wrep1 = "oui" Or wrep1 = "Oui" Or wrep1 = "o" Or wrep1 = "O" Then
Else
err_zone = 1
Exit Sub
End If
End If
End If
End If
If Target.Address = "$D$7" Or Target.Address = "$D$7:$F$7" Then ' Lieu de départ
ActiveSheet.Unprotect ("dc3618")
ctl_lieudep
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$B$8" Or Target.Address = "$B$8:$C$8" Then ' guide
ActiveSheet.Unprotect ("dc3618")
ctl_gui
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$C$9" Then ' Moyens de transport
ActiveSheet.Unprotect ("dc3618")
ctl_moytransp
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$B$10" Or Target.Address = "$B$10:$f$10" Then ' Itineraire route
ActiveSheet.Unprotect ("dc3618")
ctl_ITINERAIRE
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$B$12" Or Target.Address = "$B$12:$F$12" Then 'Lieux de passage
ActiveSheet.Unprotect ("dc3618")
ctl_lieupass
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$E$16" Or Target.Address = "$E$16:$F$16" Then
zdenivp = Range("$e$16")
zdenivs = Range("$e$16")
zdenivp = Replace(zdenivp, "Metres", "")
zdenivp = Replace(zdenivp, "Mètres", "")
zdenivp = Replace(zdenivp, "metres", "")
zdenivp = Replace(zdenivp, "mètres", "")
zdenivp = Replace(zdenivp, "Metre", "")
zdenivp = Replace(zdenivp, "Mètre", "")
zdenivp = Replace(zdenivp, "metre", "")
zdenivp = Replace(zdenivp, "mètre", "")
zdenivp = Replace(zdenivp, "M", "")
zdenivp = Replace(zdenivp, "m", "")
zdenivp = Replace(zdenivp, " ", "")
If zdenivp <> zdenivs Then
Range("$e$16") = zdenivp
End If
ActiveSheet.Unprotect ("dc3618")
ctl_denivp
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$E$17" Or Target.Address = "$E$17:$F$17" Then
zdenivm = Range("$e$17")
zdenivx = Range("$e$17")
zdenivm = Replace(zdenivm, "Metres", "")
zdenivm = Replace(zdenivm, "Mètres", "")
zdenivm = Replace(zdenivm, "metres", "")
zdenivm = Replace(zdenivm, "mètres", "")
zdenivm = Replace(zdenivm, "Metre", "")
zdenivm = Replace(zdenivm, "Mètre", "")
zdenivm = Replace(zdenivm, "metre", "")
zdenivm = Replace(zdenivm, "mètre", "")
zdenivm = Replace(zdenivm, "M", "")
zdenivm = Replace(zdenivm, "m", "")
zdenivm = Replace(zdenivm, " ", "")
If zdenivm <> zdenivx Then
Range("$e$17") = zdenivm
End If
ActiveSheet.Unprotect ("dc3618")
ctl_denivm
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$E$19" Or Target.Address = "$E$19:$F$19" Then
zdistas = Range("$e$19")
zdistan = Range("$e$19")
zdistan = Replace(zdistan, "KM", "")
zdistan = Replace(zdistan, "Km", "")
zdistan = Replace(zdistan, "km", "")
zdistan = Replace(zdistan, " ", "")
If zdistan <> zdistas Then
Range("$e$19") = zdistan
End If
ActiveSheet.Unprotect ("dc3618")
ctl_distance
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$B$7" Or Target.Address = "$B$7:$C$7" Then 'A
zsaf = Range("$b$7")
If zftest = "non" Then 'B
' replace "H" or "h" by ":"
' replace spaces by empty
zhdepart = Range("$B$7")
tpsdur
If zhdepart = zsaf Then 'C
Else
zftest = "oui"
Range("a101") = zhdepart
z2points = Range("a100")
If z2points = "Vrai" Then 'D
zhdepart = "00:" & zhdepart
End If 'D
Range("$b$7") = zhdepart
End If 'C
Else
' Heure de départ
ActiveSheet.Unprotect ("dc3618")
ctl_heudep
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
Range("D7").Select
zftest = "non"
End If 'B
End If 'if not B7 'A
' ------------------------------------
If Target.Address = "$C$16" Then 'A Durée
zsaf = Range("$C$16")
If zftest = "non" Then 'B
zhdepart = Range("$C$16")
tpsdur
If zhdepart = zsaf Then 'C
Else
zftest = "oui"
Range("a101") = zhdepart
z2points = Range("a100")
If z2points = "Vrai" Then 'D
zhdepart = "00:" & zhdepart
End If 'D
Range("$c$16") = zhdepart
End If 'C
End If ' B
ActiveSheet.Unprotect ("dc3618")
ctl_durée
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
Range("E16").Select
zftest = "non"
End If 'if not C16 'A
' ------------------------------------
If Target.Address = "$C$17" Or Target.Address = "$C$17:$D$17" Then 'A
zsaf = Range("$C$17")
If zftest = "non" Then 'B
zhdepart = Range("$C$17")
tpsdur
If zhdepart = zsaf Then 'C
Else
zftest = "oui"
Range("a101") = zhdepart
z2points = Range("a100")
If z2points = "Vrai" Then 'D
zhdepart = "00:" & zhdepart
End If 'D
Range("$c$17") = zhdepart
End If 'C
End If 'B
ActiveSheet.Unprotect ("dc3618")
ctl_pauses
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
Range("E17").Select
zftest = "non"
'B
End If 'if not C17 'A
If Target.Address = "$C$19" Then ' Rythmes
ActiveSheet.Unprotect ("dc3618")
ctl_rythme
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$B$20" Or Target.Address = "$B$20:$C$20" Then 'TYpe de repas
ActiveSheet.Unprotect ("dc3618")
ctl_typerepas
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$E$20" Or Target.Address = "$E$20:$F$20" Then ' Regions
ActiveSheet.Unprotect ("dc3618")
ctl_region
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$B$21" Or Target.Address = "$B$21:$C$21" Then ' date limite inscription Office de tourisme
ActiveSheet.Unprotect ("dc3618")
ctl_datlim
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$D$30" Then ' unité type
ActiveSheet.Unprotect ("dc3618")
ctl_unit
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$F$30" Then 'Unite NB
ActiveSheet.Unprotect ("dc3618")
ctl_unit
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Range("$F$30") = 1
Exit Sub
End If
End If
If Target.Address = "$B$36" Or Target.Address = "$B$36:$C$36" Then 'Heures de bénévolat
ActiveSheet.Unprotect ("dc3618")
ctl_HBEN
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
If Target.Address = "$D$36" Or Target.Address = "$D$36:$F$36" Then 'KM Benevolat
ActiveSheet.Unprotect ("dc3618")
ctl_KMBEN
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
End If
' ------------------------------------
If Target.Address = "$B$30" Or Target.Address = "$B$30:$C$30" Then 'A
zsaf = Range("$b$30")
If zftest = "non" Then 'B
zhdepart = Range("$b$30")
tpsdur
If zhdepart = zsaf Then 'C
Else
zftest = "oui"
Range("a101") = zhdepart
z2points = Range("a100")
If z2points = "Vrai" Then 'D
zhdepart = "00:" & zhdepart
End If 'D
Range("$b$30") = zhdepart
End If 'C
End If 'B
'retour
ActiveSheet.Unprotect ("dc3618")
ctl_retour
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
If err_zone = 1 Then
MsgBox (xtext1)
Exit Sub
End If
Range("B31").Select
zftest = "non"
'B
End If 'if not B30 'A
End If ' si indic_open = "1"
End Sub
Sub tpsdur()
zhdepart = Replace(zhdepart, "Heures", ":")
zhdepart = Replace(zhdepart, "heures", ":")
zhdepart = Replace(zhdepart, "Heure", ":")
zhdepart = Replace(zhdepart, "heure", ":")
zhdepart = Replace(zhdepart, "Minutes", "")
zhdepart = Replace(zhdepart, "minutes", "")
zhdepart = Replace(zhdepart, "Minute", "")
zhdepart = Replace(zhdepart, "minute", "")
zhdepart = Replace(zhdepart, "Mn", "")
zhdepart = Replace(zhdepart, "MN", "")
zhdepart = Replace(zhdepart, "mn", "")
zhdepart = Replace(zhdepart, "H", ":")
zhdepart = Replace(zhdepart, "h", ":")
zhdepart = Replace(zhdepart, "M", "")
zhdepart = Replace(zhdepart, "m", "")
zhdepart = Replace(zhdepart, " ", "")
End Sub
' Code pour "Thisworkbook"===============================================================================================
#If VBA7 Then
Private Declare PtrSafe Function SetCurrentDirectoryA Lib "Kernel32" (ByVal lpPathName As String) As Long
#Else
Private Declare Function SetCurrentDirectoryA Lib "Kernel32" (ByVal lpPathName As String) As Long
#End If
'Private Declare PtrSafe Function SetCurrentDirectoryA Lib "Kernel32" (ByVal lpPathName As String) As Long
'Private Sub Workbook_BeforeClose(Cancel As Boolean)
'For Each w In Application.Workbooks
'w.Save
'Next w
'Application.Quit
'End Sub
'La fermeture du classeur peut être annulée en attribuant la valeur True à la variable "Cancel".
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'
Worksheets("Rando ").Activate
ActiveSheet.Unprotect ("dc3618")
ERR_GEN = 0
adrsav = "B5"
'------------------------
If ERRGEN = 0 Then
ctl_nom
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "b5"
MsgBox (xtext1)
Exit Sub
Else
' controler / dans le texte Si erreur Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_date
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "b6"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_gui
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "b8"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_heudep
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "b7"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_lieudep
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "d7"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_ITINERAIRE
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "b10"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_lieupass
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "b12"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_moytransp
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "c9"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_durée
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "c16"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_pauses
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "c17"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
zdenivp = Range("$e$16")
zdenivs = Range("$e$16")
zdenivp = Replace(zdenivp, "Metres", "")
zdenivp = Replace(zdenivp, "Mètres", "")
zdenivp = Replace(zdenivp, "metres", "")
zdenivp = Replace(zdenivp, "mètres", "")
zdenivp = Replace(zdenivp, "Metre", "")
zdenivp = Replace(zdenivp, "Mètre", "")
zdenivp = Replace(zdenivp, "metre", "")
zdenivp = Replace(zdenivp, "mètre", "")
zdenivp = Replace(zdenivp, "M", "")
zdenivp = Replace(zdenivp, "m", "")
zdenivp = Replace(zdenivp, " ", "")
If zdenivp <> zdenivs Then
Range("$e$16") = zdenivp
End If
ctl_denivp
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "e16"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
zdenivm = Range("$e$17")
zdenivx = Range("$e$17")
zdenivm = Replace(zdenivm, "Metres", "")
zdenivm = Replace(zdenivm, "Mètres", "")
zdenivm = Replace(zdenivm, "metres", "")
zdenivm = Replace(zdenivm, "mètres", "")
zdenivm = Replace(zdenivm, "Metre", "")
zdenivm = Replace(zdenivm, "Mètre", "")
zdenivm = Replace(zdenivm, "metre", "")
zdenivm = Replace(zdenivm, "mètre", "")
zdenivm = Replace(zdenivm, "M", "")
zdenivm = Replace(zdenivm, "m", "")
zdenivm = Replace(zdenivm, " ", "")
If zdenivm <> zdenivx Then
Range("$e$17") = zdenivm
End If
ctl_denivm
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "e17"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
zdistas = Range("$e$19")
zdistan = Range("$e$19")
zdistan = Replace(zdistan, "KM", "")
zdistan = Replace(zdistan, "Km", "")
zdistan = Replace(zdistan, "km", "")
zdistan = Replace(zdistan, " ", "")
If zdistan <> zdistas Then
Range("$e$19") = zdistan
End If
ctl_distance
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "e19"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_rythme
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "c19"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_region
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "e20"
MsgBox (xtext1)
Exit Sub
End If
End If
'______________________________________
If Range("c16") = "" Or Range("e19") = "" Then
Else
zmoy = Range("c217")
If zmoy = 0 Then
moyenne = Range("Moyenne_OK")
Else
moyenne = 1
End If
If moyenne = 0 Then
Else
zmoyenne = Range("c214") / 1000
'message
xtext3 = "Rapport Distance / durée = Vitesse "
xtext1 = "Attention: La vitesse moyenne de marche semble anormale (" & zmoyenne & "Km/H )"
'Information xtext1
MsgBox xtext1, vbYesonly, xtext3
End If
End If
'_______________________________________
If ERRGEN = 0 Then
ctl_retour
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "b30"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_HBEN
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "b36"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_KMBEN
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "d36"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_typerepas
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "b20"
MsgBox (xtext1)
Exit Sub
End If
End If
If ERRGEN = 0 Then
ctl_datlim
If err_zone = 1 Then
'Information xtext1
ERRGEN = 1
adrsav = "b21"
MsgBox (xtext1)
Exit Sub
End If
End If
'____________________________________________________________
'Si ERRGEN = 1, la variable Cancel vaudra TRUE (ce qui annulera la fermeture)
If ERRGEN = 1 Then 'x
Range(adrsav).Select
Cancel = True
Else
SetUNCPath "C:\CVS\GUIDES"
vardir = "C:\CVS\GUIDES"
ChDir (vardir)
'____________________________________________________________
nom_feuil = ActiveWorkbook.Name
Range("B6:F6").Select 'Date
Range("B8:C8").Select 'Guide"
Range("a5").Select 'titre
'
za = Range("m6") 'jour
zm = Range("n6") 'mois
zj = Range("o6") 'année
z2 = Range("guide")
zt = Range("b5")
'zname = zj & zm & za & "-" & z2 'nouveau nom donné au fichier
zname = zj & zm & za & "-" & z2 & "-" & zt 'nouveau nom donné au fichier
If nom_feuil = "Formulaire de rando_simplifié.xls" Then 'y
'save as
ActiveWorkbook.SaveAs Filename:=zname, FileFormat:=xlExcel8
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
Application.ScreenUpdating = True
Application.GoTo Reference:="CLUB_VOSGIEN_DE_SAVERNE"
Range("B5:F5").Select
Range("B5:F5").Activate
Else
' si nom du fichier est different de Formulaire de rando_simplifié.xls
' ____________________________
zname1 = zname & ".xls"
If zname1 = nom_feuil Then 'y1
ActiveWorkbook.Save
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
Application.ScreenUpdating = True
Application.GoTo Reference:="CLUB_VOSGIEN_DE_SAVERNE"
Range("B5:F5").Select
Range("B5:F5").Activate
Else
msguname = "Erreur Le nom du fichier lu (" & nom_feuil & ") est différent du nom généré avec la nouvelle date et/ou le nouveau guide et/ou le nouveau Titre (" & zname & ")"
MsgBox (msguname)
question = InputBox("La nouvelle Date de la randonnée et/ou le nouveau Guide et/ou le nouveau titre sont-ils corrects ? ")
If question = "OUI" Or question = "oui" Or question = "Oui" Or question = "o" Or question = "O" Then 'y2
'
zname1 = zname & "-Renommé"
ActiveWorkbook.SaveAs Filename:=zname1, FileFormat:=xlExcel8
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
Application.ScreenUpdating = True
Application.GoTo Reference:="CLUB_VOSGIEN_DE_SAVERNE"
Range("B5:F5").Select
Range("B5:F5").Activate
Else
MsgBox ("Au message de sauvegarde suivant Répondez ANNULER, puis rectifiez la Date de la randonnée et/ou le Guide et/ou le Titre.")
Range("date_rando").Select
Exit Sub
End If 'y2
End If 'y1
End If 'y
End If 'x
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
End Sub
Function SetUNCPath(sPath As String) As Long
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(sPath)
SetUNCPath = lReturn
End Function
Private Sub Workbook_Open()
Stop
Dim test
test = "debut"
Debug.Print test
MsgBox ("start")
End Sub
' Code pour "module1"===============================================================================================
Public err_zone As String
Public xtext1 As String
Public xtext3 As String
#If VBA7 Then
Private Declare PtrSafe Function Beep Lib "Kernel32" (ByVal Fq As Long, ByVal Tm As Long) As Long
#Else
Private Declare Function Beep Lib "Kernel32" (ByVal Fq As Long, ByVal Tm As Long) As Long
#End If
'Private Declare PtrSafe Function Beep Lib "Kernel32" (ByVal Fq As Long, ByVal Tm As Long) As Long
' Prononcer_un_texte Macro
'
'générer soi même des phrases :
'd 'abord cocher dans VBAproject la réference à :
'Microsoft Speech Object Library
'insere ensuite ce code dans un module standard :
'--------------------
'
Sub Information(ByVal Phrase As String)
On Error GoTo handlecancel
Application.EnableCancelKey = xlErrorHandler
Application.StatusBar = Phrase
Assistant.Visible = True
'Vocal.Speak Phrase
Application.Speech.Speak Phrase
Exit Sub
handlecancel:
' if err = 18 then
'Application.Speech.Speak "lecture orale interrompue"
'endif
End Sub
Sub auto_close()
'
'
Sheets("Rando ").Select
ActiveSheet.Unprotect ("dc3618")
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
Sheets("Inscriptions").Select
TRI
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
Sheets("Rando ").Select
End Sub
Sub ctl_nom()
err_zone = 0
zobl = Range("nom_rando")
If zobl = "" Then
xtext1 = "LE TITRE de la randonnée est obligatoire."
xtext3 = "TITRE RANDONNEE"
err_zone = 1
'Exit Sub
Else
'
If Range("h34") <> 0 Then
xtext1 = "LE TITRE de la randonnée ne doit pas contenir de caractère "" / "". "
xtext3 = "TITRE RANDONNEE"
err_zone = 1
'Exit Sub
End If
If Range("h2") <> 0 Then
xtext1 = "LE TITRE de la randonnée ne doit pas contenir de caractère "" * "". "
xtext3 = "TITRE RANDONNEE"
err_zone = 1
'Exit Sub
End If
End If
End Sub
Sub ctl_date()
err_zone = 0
zobl = Range("B6")
If zobl = "" Then
xtext1 = "Date de la randonnée au format JJ/MM/AAAA est obligatoire. "
xtext3 = "DATE RANDONNEE"
err_zone = 1
'Exit Sub
Else
If Not IsDate([b6]) Then
xtext1 = "Date de la randonnée: format erronné. "
xtext3 = "FORMAT DATE RANDONNEE"
err_zone = 1
'Exit Sub
End If
End If
End Sub
Sub ctl_heudep()
err_zone = 0
ActiveSheet.Unprotect ("dc3618")
zobl = Range("B7")
If zobl = "" Then
xtext1 = "Heure de départ de la randonnée au format HH:MM est obligatoire. "
xtext3 = "HEURE DE DEPART"
err_zone = 1
'Exit Sub
Else
Range("h37") = zobl
Range("h38").Select
ActiveCell.Formula = "=HOUR(H37)"
If Range("h39") = "ERREUR" Then
zheur = 0
Else
zheur = Range("h38")
End If
Range("b7").Select
If Range("h39") = "" Then
Else
xtext1 = "Heure de départ de la randonnée: format HH erronné. "
xtext3 = "HEURE DE DEPART"
err_zone = 1
' Exit Sub
End If
Range("h37") = zobl
Range("h38").Select
ActiveCell.Formula = "=Minute(H37)"
If Range("h39") = "ERREUR" Then
zheur = 0
Else
zheur = Range("h38")
End If
Range("b7").Select
If Range("h39") = "" Then
Else
xtext1 = "Minutes du départ de la randonnée: format MM erronné. "
xtext3 = "HEURE DE DEPART"
err_zone = 1
'Exit Sub
End If
End If
If err_zone = 1 Then
Range("B7").Select
Else
Range("d7").Select
End If
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
End Sub
Sub ctl_lieudep()
err_zone = 0
zobl = Range("Lieu_de_départ")
If zobl = "" Or zobl = " " Then
xtext1 = "Lieu de départ de la randonnée est obligatoire. "
xtext3 = "LIEU DE DEPART"
err_zone = 1
'Exit Sub
End If
End Sub
Sub ctl_gui()
err_zone = 0
zobl = Range("b8")
If zobl = "" Then
xtext1 = "NOM DU GUIDE de la randonnée est obligatoire. "
xtext3 = "NOM DU GUIDE"
err_zone = 1
'Exit Sub
Else
'm2 à m101
idx = 1
While idx < 102
idx = idx + 1
zadd = "AM" & idx
ztab = Range(zadd)
If zobl = ztab Then idx = 500
Wend
If idx = 500 Then
Else
xtext1 = "GUIDE de la randonnée est inconnu. "
xtext3 = "GUIDE"
err_zone = 1
'Exit Sub
End If
End If
End Sub
Sub ctl_moytransp()
err_zone = 0
zobl = Range("c9")
If zobl = "" Then
xtext1 = "MOYEN DE TRANSPORT de la randonnée est obligatoire. "
xtext3 = "MOYEN DE TRANSPORT"
err_zone = 1
'Exit Sub
Else
'd2 à d11
idx = 1
While idx < 12
idx = idx + 1
zadd = "AD" & idx
ztab = Range(zadd)
If zobl = ztab Then idx = 50
Wend
If idx = 50 Then
Else
xtext1 = "MOYEN DE TRANSPORT de la randonnée est erronnée. "
xtext3 = "MOYEN DE TRANSPORT"
err_zone = 1
'Exit Sub
End If
ztrj = Range("trjkm")
If (ztrj = 0 Or ztrj = "") And zobl = "Voitures particulières" Then
xtext1 = "KM DE TRAJET OBLIGATOIRE SI MOYEN DE TRANSPORT = Voitures particulieres. "
xtext3 = "KM TRAJET"
err_zone = 1
'Exit Sub
End If
End If
End Sub
Sub ctl_ITINERAIRE()
err_zone = 0
zobl = Range("itinéraire_route")
If zobl = "" Then
xtext1 = "Itinéraire_route est obligatoire sur la première ligne de la zone. "
xtext3 = "Itinéraire_route"
err_zone = 1
'Exit Sub
End If
End Sub
Sub ctl_ARTICLE()
err_zone = 0
zobl = Range("Art_presse")
If zobl = "" Then
xtext1 = "Choix article de presse est obligatoire. "
xtext3 = "Article presse"
err_zone = 1
'Exit Sub
End If
End Sub
Sub ctl_lieupass()
err_zone = 0
zobl = Range("Principaux_points_de_passage")
If zobl = "" Then
xtext1 = "Principaux points de passage de la randonnée est obligatoire sur la première ligne de la zone "
xtext3 = "Principaux_points_de_passage"
err_zone = 1
'Exit Sub
End If
End Sub
Sub ctl_durée()
err_zone = 0
ActiveSheet.Unprotect ("dc3618")
zobl = Range("durée")
If zobl = "" Then
xtext1 = "DUREE de la randonnée au format HH : MM est obligatoire. "
xtext3 = "DUREE"
err_zone = 1
'Exit Sub
Else
Range("h37") = zobl
Range("h38").Select
ActiveCell.Formula = "=HOUR(H37)"
If Range("h39") = "ERREUR" Then
zheur = 0
Else
zheur = Range("h38")
End If
If Range("h39") = "" Then
If zheur > 12 Then
xtext1 = "Durée de la randonnée supérieure à 12 heures!. " & zheur
xtext3 = "DUREE"
err_zone = 1
'Exit Sub
End If
Else
xtext1 = "Durée de la randonnée: format HH erronné. "
xtext3 = "DUREE"
err_zone = 1
'Exit Sub
End If
Range("h37") = zobl
Range("h38").Select
ActiveCell.Formula = "=Minute(H37)"
If Range("h39") = "ERREUR" Then
zheur = 0
Else
zheur = Range("h38")
End If
If Range("h39") = "" Then
Else
xtext1 = "Durée de la randonnée format MM erronné. "
xtext3 = "DUREE"
err_zone = 1
'Exit Sub
End If
End If
If err_zone = 1 Then
Range("durée").Select
Else
Range("e16").Select
End If
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
End Sub
Sub ctl_denivp()
err_zone = 0
zobl = Range("denivpos")
If zobl = "" Then
xtext1 = "DENIVELEE POSITIVE de la randonnée est obligatoire. "
xtext3 = "DENIVELEE POSITIVE"
err_zone = 1
'Exit Sub
Else
If IsNumeric(Range("denivpos")) Then
If zobl > 2000 Then
xtext1 = "DENIVELEE POSITIVE > 2000 mètres!. "
xtext3 = "DENIVELEE POSITIVE "
err_zone = 1
'Exit Sub
End If
Else
xtext1 = "DENIVELEE POSITIVE : format erronné. "
xtext3 = "DENIVELEE POSITIVE "
err_zone = 1
'Exit Sub
End If
End If
End Sub
Sub ctl_pauses()
err_zone = 0
ActiveSheet.Unprotect ("dc3618")
zobl = Range("pauses")
If zobl = "" Then
xtext1 = "TEMPS DE PAUSE de la randonnée est obligatoire. "
xtext3 = "TEMPS DE PAUSE"
err_zone = 1
'Exit Sub
Else
Range("h37") = zobl
Range("h38").Select
ActiveCell.Formula = "=HOUR(H37)"
If Range("h39") = "ERREUR" Then
zheur = 0
Else
zheur = Range("h38")
End If
If Range("h39") = "" Then
Else
xtext1 = "TEMPS DE PAUSE de la randonnée: format HH erronné. "
xtext3 = "TEMPS DE PAUSE"
err_zone = 1
'Exit Sub
End If
If zheur > 4 Then
xtext1 = "TEMPS DE PAUSE de la randonnée > 4 heures!. "
xtext3 = "TEMPS DE PAUSE"
err_zone = 1
'Exit Sub
End If
Range("h37") = zobl
Range("h38").Select
ActiveCell.Formula = "=Minute(H37)"
If Range("h39") = "ERREUR" Then
zheur = 0
Else
zheur = Range("h38")
End If
If Range("h39") = "" Then
Else
xtext1 = "TEMPS DE PAUSE de la randonnée format MM erronné. "
xtext3 = "TEMPS DE PAUSE"
err_zone = 1
'Exit Sub
End If
End If
If err_zone = 1 Then
Range("pauses").Select
Else
Range("E17").Select
End If
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
End Sub
Sub ctl_denivm()
err_zone = 0
zobl = Range("denivneg")
If zobl = "" Then
xtext1 = "DENIVELEE NEGATIVE de la randonnée est obligatoire. "
xtext3 = "DENIVELEE NEGATIVE"
err_zone = 1
'Exit Sub
Else
If IsNumeric(Range("denivneg")) Then
If zobl > 3000 Then
xtext1 = "DENIVELEE NEGATIVE > 3000 mètres!. "
xtext3 = "DENIVELEE NEGATIVE"
err_zone = 1
'Exit Sub
End If
Else
xtext1 = "DENIVELEE NEGATIVE : format erronné. "
xtext3 = "DENIVELEE NEGATIVE"
err_zone = 1
'Exit Sub
End If
End If
End Sub
Sub ctl_rythme()
err_zone = 0
zobl = Range("c19")
If zobl = "" Then
xtext1 = "RYTHME de la randonnée est obligatoire. "
xtext3 = "RYTHME de la randonnée"
err_zone = 1
'Exit Sub
Else
'Ac2 à Ac11
idx = 1
While idx < 12
idx = idx + 1
zadd = "AC" & idx
ztab = Range(zadd)
If zobl = ztab Then idx = 50
Wend
If idx = 50 Then
Else
xtext1 = "RYTHME de la randonnée est erronné. "
xtext3 = "RYTHME"
err_zone = 1
'Exit Sub
End If
End If
End Sub
Sub ctl_distance()
err_zone = 0
zobl = Range("distance")
If zobl = "" Then
xtext1 = "DISTANCE en Kilomètres de la randonnée est obligatoire. "
xtext3 = "DISTANCE en Kilomètres"
err_zone = 1
'Exit Sub
Else
If IsNumeric(Range("distance")) Then
If zobl > 30 Then
xtext1 = "DISTANCE supérieure à 30 kilomètres. "
xtext3 = "DISTANCE "
err_zone = 1
'Exit Sub
End If
Else
xtext1 = "DISTANCE : format erronné. "
xtext3 = "DISTANCE "
err_zone = 1
'Exit Sub
End If
End If
End Sub
Sub ctl_typerepas()
err_zone = 0
zobl = Range("b20")
If zobl = "" Then
xtext1 = "TYPE DE REPAS de la randonnée est obligatoire. "
xtext3 = "TYPE DE REPAS de la randonnée"
err_zone = 1
'Exit Sub
Else
'f2 à f11
idx = 1
While idx < 12
idx = idx + 1
zadd = "AF" & idx
ztab = Range(zadd)
If zobl = ztab Then idx = 50
Wend
If idx = 50 Then
Else
xtext1 = "TYPE DE REPAS de la randonnée est erronné. "
xtext3 = "TYPE DE REPAS"
err_zone = 1
'Exit Sub
End If
End If
End Sub
Sub ctl_region()
err_zone = 0
zobl = Range("region")
If zobl = "" Then
xtext1 = "REGION de la randonnée est obligatoire. "
xtext3 = "REGION"
err_zone = 1
'Exit Sub
Else
'b2 à b21
idx = 1
While idx < 22
idx = idx + 1
zadd = "AB" & idx
ztab = Range(zadd)
If zobl = ztab Then idx = 50
Wend
If idx = 50 Then
Else
xtext1 = "REGION de la randonnée est erronnée. "
xtext3 = "REGION"
err_zone = 1
'Exit Sub
End If
End If
End Sub
Sub ctl_datlim()
err_zone = 0
'wcategor = Range("categ")
zobl = Range("Date_Limite_d_inscription_Office_tourisme")
If zobl = "" And Range("date_rando") <> "" Then
Range("Date_Limite_d_inscription_Office_tourisme") = Range("date_rando")
'xtext1 = "LA DATE LIMITE D'INSCRIPTION A L'OFFICE DE TOURISME est obligatoire."
'xtext3 = "DATE LIMITE D'INSCRIPTION"
'err_zone = 1
End If
End Sub
Sub ctl_retour()
err_zone = 0
ActiveSheet.Unprotect ("dc3618")
zobl = Range("retour")
If zobl = "" Then
xtext1 = "HEURE DE RETOUR de la randonnée est obligatoire. "
xtext3 = "HEURE DE RETOUR "
err_zone = 1
' Exit Sub
Else
Range("h37") = zobl
Range("h38").Select
ActiveCell.Formula = "=HOUR(H37)"
If Range("h39") = "ERREUR" Then
zheur = 0
Else
zheur = Range("h38")
End If
If Range("h39") = "" Then
Else
xtext1 = "Heure de retour de la randonnée: format HH erronné. "
xtext3 = "HEURE DE RETOUR"
err_zone = 1
'Exit Sub
End If
Range("h37") = zobl
Range("h38").Select
ActiveCell.Formula = "=Minute(H37)"
If Range("h39") = "ERREUR" Then
zheur = 0
Else
zheur = Range("h38")
End If
If Range("h39") = "" Then
Else
xtext1 = "Minutes du retour de la randonnée: format MM erronné. "
xtext3 = "HEURE DE RETOUR"
err_zone = 1
'Exit Sub
End If
End If
If err_zone = 1 Then
Range("retour").Select
Else
Range("b36").Select
End If
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
End Sub
Sub ctl_unit()
err_zone = 0
zobl = Range("H19")
If zobl <> " " Then
xtext1 = "Unité / NOMBRE d'unités sont incomplets ou erronés. (Forcé à valeur=1) "
xtext3 = "Unité / NOMBRE d'unités"
err_zone = 1
'Exit Sub
End If
End Sub
Sub ctl_HBEN()
err_zone = 0
ActiveSheet.Unprotect ("dc3618")
zobl = Range("Heures_de_Bénévolat")
If zobl = "" Then
xtext1 = "Heures de Bénévolat de la randonnée est obligatoire. ZERO admis"
xtext3 = "Heures_de_Bénévolat"
err_zone = 1
'Exit Sub
Else
Range("h37") = zobl
Range("h38").Select
ActiveCell.Formula = "=HOUR(H37)"
If Range("h39") = "ERREUR" Then
zheur = 0
Else
zheur = Range("h38")
End If
Range("Heures_de_Bénévolat").Select
If Range("h39") = "" Then
Else
xtext1 = "Heures de Bénévolat: format HH erronné. "
xtext3 = "Heures de Bénévolat"
err_zone = 1
'Exit Sub
End If
Range("h37") = zobl
Range("h38").Select
ActiveCell.Formula = "=Minute(H37)"
If Range("h39") = "ERREUR" Then
zheur = 0
Else
zheur = Range("h38")
End If
Range("Heures_de_Bénévolat").Select
If Range("h39") = "" Then
Else
xtext1 = "Heures de Bénévolat de la randonnée: format MM erronné. "
xtext3 = "Heures de Bénévolat"
err_zone = 1
' Exit Sub
End If
If IsNumeric(Range("Heures_de_Bénévolat")) Then
If zobl > 100 Then
xtext1 = "Heures de Bénévolat' > 100 H!. "
xtext3 = "Heures de Bénévolat "
err_zone = 1
' Exit Sub
End If
End If
End If
If err_zone = 1 Then
Range("heures_de_bénévolat").Select
Else
Range("d36").Select
End If
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
End Sub
Sub ctl_KMBEN()
err_zone = 0
zobl = Range("KM_de_Bénévolat")
If zobl = "" Then
xtext1 = "KM de Bénévolat de la randonnée est obligatoire. ZERO admis."
xtext3 = "KM de Bénévolat"
err_zone = 1
'Exit Sub
Else
If IsNumeric(Range("KM_de_Bénévolat")) Then
If zobl > 2000 Then
xtext1 = "KM de Bénévolat' > 2000 KM!. "
xtext3 = "KM de Bénévolat "
err_zone = 1
'Exit Sub
End If
Else
xtext1 = "KM de Bénévolat de la randonnée est obligatoire. ZERO admis. "
xtext3 = "KM de Bénévolat "
err_zone = 1
' Exit Sub
End If
End If
End Sub
' Code pour Module2 ===========================================================================================
Sub Graphique1_Cliquer()
'
ActiveWindow.ScrollWorkbookTabs Sheets:=-3
Sheets("Rando ").Select
Range("C19").Select
End Sub
' Code pour Module3 ===========================================================================================
Public indic_open As String
Public nom_feuil As String
Sub auto_open()
'On Error Resume Next
MsgBox ("auto_open")
nom_feuil = ActiveWorkbook.Name
currentpath = ThisWorkbook.Path
'Range("A4").Select
'ActiveCell.FormulaR1C1 = "=INFO(""repertoire"")"
'CurrentPath = Range("A4")
'Range("A4") = " "
If currentpath = "C:\CVS\GUIDES" Then
Else
MSG001 = "Le Fichier " & nom_feuil & " doit impérativement se trouver dans le répertoire C:\CVS\GUIDES. Il se trouve actuellement dans le répertoire : " & currentpath & " Veuillez le déplacer dans le répertoire C:\CVS\GUIDES puis Relancer"
MSG002 = "Le traitement en cours est interrompu"
MsgBox (MSG001)
MsgBox (MSG002)
Exit Sub
Stop
End If
'
indic_open = "0"
' Sheets(1).Select
Sheets("Rando ").Select
Range("B5:F5").Select
zftest = "non"
If nom_feuil = "Formulaire de rando_simplifié.xls" Then
indic_open = "1"
RAZ
indic_open = "0"
End If
End Sub
' Code pour Module4 ===========================================================================================
Sub RAZ()
'
' RAZ Macro
'
'
Range("B5:F5").Select
Selection.ClearContents
Range("B6:F6").Select
Selection.ClearContents
Range("B7:C7").Select
Selection.ClearContents
Range("B8:C8").Select
Selection.ClearContents
Range("B9").Select
Selection.ClearContents
Range("C9").Select
Selection.ClearContents
Range("B12:F12").Select
Selection.ClearContents
Range("C16").Select
Selection.ClearContents
Range("E16:F16").Select
Selection.ClearContents
Range("C17").Select
Selection.ClearContents
Range("E17:F17").Select
Selection.ClearContents
Range("C19").Select
Selection.ClearContents
Range("E19:F19").Select
Selection.ClearContents
Range("B21:C21").Select
Selection.ClearContents
Range("B30:C30").Select
Selection.ClearContents
Range("B31:F35").Select
Selection.ClearContents
Range("B36:C36").Select
Selection.ClearContents
Range("D36:F36").Select
Selection.ClearContents
Sheets("Inscriptions").Select
Range("B10:E40").Select
Selection.ClearContents
Sheets("Inscriptions").Select
Range("b10:e49").Select
Selection.ClearContents
INF_COMPL
Sheets("Rando ").Select
' indic_open = "0"
End Sub
Sub INF_COMPL()
'
' Supprimer et recréer l'onglet des Informations complémentaires lors de l'ouverture du formulaire de référence
'
'
Sheets("Informations complémentaires").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets.Add After:=ActiveSheet
namesheet = ActiveSheet.Name
Sheets(namesheet).Select
Sheets(namesheet).Name = "Informations complémentaires"
Range("A1").Select
ActiveCell.FormulaR1C1 = _
"Inscrire ici toutes informations complémentaires relatives à cette randonnée. (Textes, Images,Liens...etc...)"
Columns("A:A").ColumnWidth = 159.57
Sheets("Informations complémentaires").Select
With ActiveWorkbook.Sheets("Informations complémentaires").Tab
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.399975585192419
End With
'
Cells.Select
Selection.Locked = False
Selection.FormulaHidden = False
Range("A1").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect ("dc3618"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False
Sheets("Rando ").Select
End Sub
' Code pour Module8 ===========================================================================================
Sub TRI()
'
' TRI Macro
' Tri des randonneurs sur leurs noms
'
'
Range("B10:E49").Select
ActiveWorkbook.Worksheets("Inscriptions").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Inscriptions").Sort.SortFields.Add Key:=Range( _
"B10:B49"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Inscriptions").Sort.SortFields.Add Key:=Range( _
"C10:C49"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Inscriptions").Sort
.SetRange Range("B10:E49")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B10").Select
End Sub
' =================================fin du code
