Option Base 1
Option Explicit
 » *****************************************************************************
 » Module de traitement non spécialisé
 » *****************************************************************************

‘ Liste des Programmes et Fonctions de ce MODULE :

‘ Sub auto_open() : Programme d’initialisation qui s’execute a l’ouverture de ce classeur
‘ Public Sub InitParam() : Positionne des Flags de traitement au niveau module
‘ Public Sub ClearData() : Suppression des valeurs des cellules de la feuille active
‘ Public Function maj_barre_etat(texte_barre As String) As Integer : Ecriture de la barre d’état Excel
‘ Public Function FAfficheInfo(ByVal FMonMessage As String, _
‘ ByVal FTypeMessage As String, _
‘ ByVal FFormatMessage As String _
‘ ) As Integer
‘
‘
 » ******************************************************************************
 » LES PROGRAMMES
 » ******************************************************************************
‘
Public Sub ClearData()
 » ******************************************************************************
 » Propos : Suppression des valeurs des cellules de la feuille active
 » Ecrit : 17-Fev-2003 par Marco – MgInformatique
 »

Cells.ClearContents
End Sub
‘
Public Sub AppelCalculatrice()
 » ***************************************************************************
 » Propos : Procédure
 » Appel : Néant
 » Ecrit : 17-Fev-2003 par Marco – MgInformatique
‘
Dim retval
‘ Exécute la calculatrice.
retval = Shell(« C:\WINDOWS\CALC.EXE », 1)

End Sub
‘
Public Sub AppelBlocNote()
 » ***************************************************************************
 » Propos : Procédure
 » Appel : Néant
 » Ecrit : 17-Fev-2003 par Marco – MgInformatique
‘
Dim retval
Dim MonDrive, MonRépertoire, MonBlockNote As String
MonDrive = « C »
MonRépertoire = « Winnt »
MonBlockNote = « Notepad.exe »

‘ Exécute le notepade
retval = Shell(MonDrive & « :\ » & MonRépertoire & « \ » & MonBlockNote, 1)
End Sub
Public Sub MGMessage(ByVal FMessage As String)
 » ***************************************************************************
 » Propos : Procédure
 » Appel : Néant
 » Ecrit : 17-Fev-2003 par Marco – MgInformatique
If OPTIONVERBOSE = True Then MsgBox (FMessage)
End Sub
‘
Sub AttendreQuelquesSecondes(ByVal FNbrSeconde As Long)
 » ***************************************************************************
 » Propos : Procédure
 » Appel : Néant
 » Ecrit : 17-Fev-2003 par Marco – MgInformatique
Dim nvlleHeure, nvlleMinute, nvlleSeconde, waitTime
nvlleHeure = Hour(Now())
nvlleMinute = Minute(Now())
nvlleSeconde = Second(Now()) + FNbrSeconde
waitTime = TimeSerial(nvlleHeure, nvlleMinute, nvlleSeconde)
Application.Wait waitTime
End Sub
‘
Sub AttendreJusquaLHeure(ByVal MonAttente As Integer)
 » ***************************************************************************
 » Propos : Procédure
 » Appel : Néant
 » Ecrit : 17-Fev-2003 par Marco – MgInformatique
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + MonAttente)
End Sub
‘
Sub MaCompilation()
MsgBox « Compilation ok »
End Sub

‘
 » ******************************************************************************
 » LES FONCTIONS
 » ******************************************************************************
‘
Public Function maj_barre_etat(texte_barre As String) As Integer
 » ******************************************************************************
 » Propos : mise à jour de la barre état en fonction d’un variable texte
 » Appel : Néant
 » Ecrit : 17-Fev-2003 par Marco – MgInformatique
If texte_barre = «  » Then
Application.StatusBar = False
maj_barre_etat = 1
Else
Application.StatusBar = texte_barre
Application.ScreenUpdating = True ‘ on valide la visualisation de la manip
Application.ScreenUpdating = False ‘ on invalide la visualisation de la manip
maj_barre_etat = 0
End If
End Function
‘
Function NomDuProjet(ByRef FNomProjet As String, _
Optional ByVal FB_Ecriture As Boolean = False) As Boolean
 » ***************************************************************************
 » Propos : Modifi le nom du projet
 » Appel : Néant
 » Ecrit : 17-Avr-2005 par Marco – MgInformatique
 » Etat : Test ok
NomDuProjet = True

If FB_Ecriture Then
ThisWorkbook.VBProject.Name = FNomProjet
Else
FNomProjet = ThisWorkbook.VBProject.Name
End If
End Function
‘
Private Function ClasseurEstOuvert(nomclasseur) As Boolean
‘ Retourne TRUE si le classeur est ouvert
Dim x As Workbook
On Error Resume Next
Set x = Workbooks(nomclasseur)
If Err = 0 Then ClasseurEstOuvert = True _
Else ClasseurEstOuvert = False
End Function

Public Function lance_bat(ByVal FBat As String, ByVal FModeFenetre As Integer)
 » ***************************************************************************
 » Propos : Procédure
 » Appel : Néant
 » Ecrit : 17-Fev-2003 par Marco – MgInformatique
Dim retval As Long
retval = Shell(FBat, FModeFenetre)
If retval = 0 Then
MsgBox « Erreur d’execution du programme :  » & FBat
End If
lance_bat = retval
End Function
‘___________________________________________________________________________
‘
Public Function affiche_info(mon_message As String, type_message As String) As Integer
 » ***************************************************************************
 » Propos : fonction d’affichage de message en fonction :
 » d’une variable texte, d’un type de message
 » Appel : Néant
 » Ecrit : 17-Fev-2003 par Marco – MgInformatique
 » type message :
 » D = Débug
 » I = Info
 » C = Critique
 » O = Confirmation
Dim MON_DEBUG As Boolean
Dim Débugage
If MON_DEBUG Then
If type_message = « D » Then
affiche_info = MsgBox(mon_message, vbExclamation, Débugage)
ElseIf type_message = « I » Then
affiche_info = MsgBox(mon_message, vbInformation, Débugage)
End If
End If
If type_message = « C » Then
affiche_info = MsgBox(mon_message, vbCritical, Débugage)
ElseIf type_message = « O » Then
affiche_info = MsgBox(mon_message, vbQuestion, Débugage)
End If
End Function
‘
Function MessageEtCompteRendu(ByVal FMessage As String, _
ByVal FTitre As String, _
Optional ByVal FStyle As String = « E », _
Optional ByVal FB_Message As Boolean = False, _
Optional ByVal FB_BarreEtat As Boolean = True, _
Optional ByVal FB_CompteRendu As Boolean = False _
) As Integer
 » ***************************************************************************
 » Propos : Traite les message et les lignes du fichier compte rendu
 » Ecrit : 01-Juin-2005 par Marco – MgInformatique
 »

‘ Par default c’est une erreur a afficher dans mgbbox, barre etat et compte rendu

Dim WStyle, WTypeMessage As String
Dim lInt_FreeFileCptRendu As Integer
‘WNomFonc = « MessageEtCompteRendu » pas dans ce cas
MessageEtCompteRendu = 0
 » – – – – – – – – – – – – – – – – – – – – – – – – – – – –
‘ Traitement du WStyle
Select Case UCase(FStyle) ‘ Définit le bouton et l’icone : vbExclamation, vbInformation , vbCritical
Case « W » ‘ c’est un warning
WStyle = vbOKOnly + vbExclamation
WTypeMessage = « Warning : »
Case « I » ‘ c’est une info
WStyle = vbOKOnly + vbInformation
WTypeMessage = « Info : »
Case « E » ‘ c’est une erreur
WStyle = vbOKOnly + vbCritical
WTypeMessage = « Erreur : »
Case Else

MsgBox « Erreur style <> W, I, E dans la fonction MessageEtCompteRendu =  » & FStyle
Exit Function
End Select

 » – – – – – – – – – – – – – – – – – – – – – – – – – – – –
‘ Affichage du message
 » – – – – – – – – – – – – – – – – – – – – – – – – – – – –
If FB_Message Then MessageEtCompteRendu = MsgBox(FMessage, WStyle, FTitre)

 » – – – – – – – – – – – – – – – – – – – – – – – – – – – –
‘ Mise a jour de la barre d’état
 » – – – – – – – – – – – – – – – – – – – – – – – – – – – –
If FB_BarreEtat Then Call maj_barre_etat(WTypeMessage & FMessage)
 » – – – – – – – – – – – – – – – – – – – – – – – – – – – –
‘ Ecriture du fichier CompteRendu dans le répertoire de travail
 » – – – – – – – – – – – – – – – – – – – – – – – – – – – –
If Not FB_CompteRendu Then Exit Function

On Error GoTo ErrorHandlerFichier
lInt_FreeFileCptRendu = FreeFile
‘ ouverture du fichier en mode Append
Open NOMDUDRIVE & « : » & NOMDUREPERTOIREDETRAVAIL & NOMAPPLI & NomFlux & « \ » & NOM_FIC_COMPTE_RENDU For Append As #lInt_FreeFileCptRendu

‘ Ecriture du fichier
Print #lInt_FreeFileCptRendu, WTypeMessage & FMessage
Close #lInt_FreeFileCptRendu ‘ Ferme le fichier.

Exit Function ‘ sortie de la fonction

 » – – – – – – – – – – – – – – – – – – – – – – – – – – – –
 » Routine de traitement des erreurs
Exit Function

ErrorHandlerFichier:
MsgBox « ErrorHandlerFichier » &  »  » & Error(Err.Number) &  »  » & NOMDUDRIVE & « : » & NOMDUREPERTOIREDETRAVAIL & NOMAPPLI & NomFlux & « \ » & NOM_FIC_COMPTE_RENDU
MessageEtCompteRendu = -1
PAS_DERREUR = False
Close #lInt_FreeFileCptRendu
Exit Function

End Function
Sub quitter_excel()
Réponse = MsgBox(« Voulez-vous quitter Excel ? », vbYesNo, « A la prochaine ! »)
If Réponse = vbYes Then
ActiveWorkbook.Save
Application.WindowState = xlNormal
Application.DisplayFullScreen = False
Application.Quit
End If
End Sub