Diffusion via un intranet des plannings du logiciel "planniciel"

Télécharger le projet
Commenter

Description

Le but de ce code est de diffuser les plannings, tout en empéchant l'impression de ces derniers. Mouais c'est pas gentil mais le personnel perdait son planning tous les deux jours et le réimprimait. La personne chargée des plannings passait une après midi entière à aller les afficher, à chaque modification.
Planniciel propose de créer les fichiers dans plusieurs formats (.doc .xls .htm) j'ai retenu le format HTML car c'est celui qui rendait le meilleur aspect.

le programme en lui même est logé dans un dossier partagé (où j'ai donné les droits en écriture aux personnes chargées des plannings, le reste du personnel l'a en acces lecture et exécution seulement). Les ordinateurs des salles de soins (je bosse dans un hopital) ont un raccourci vers ce programme sur le bureau. Les fichiers HTML et .Txt que le programme appelle sont dans un dossier caché "pln" logé dans le même dossier que l'application (l'informaticien a réussi à empécher l'affichage des fichiers cachés sur ces PC).

Il affiche le mois en cours et le mois suivant.

Les fichiers 01.txt 02.txt .... 12.txt correspondent aux mois de l'année. Ils contiennent sur chaque ligne le nom du planning, le séparateur "<%;%>" et l'addresse partielle du fichier HTML du planning. Là maintenant nous sommes en septembre. dans le zip j'ai mis un planning anonymisé (celui de Antares) afin que vous puissiez voir le résultat.

voila, en espérant que ce code puisse vous inspirer pour d'autres programmes.

Source / Exemple : 


Dim table() As String
Dim erri As String, chemin As String, r As Boolean
Dim i As Integer
Dim dateactu() As String, datemoissuivant() As String

Private Sub Command1_Click()
'*************** bouton retour*****************
'page blanche
WebBrowser1.navigate ("file://" & App.Path & "PLN\Blanc.HTM")

'Masquer l'affichage du planning
Command1.Visible = False
WebBrowser1.Visible = False
Picture1.Visible = False
VScroll1.Visible = False
HScroll1.Visible = False

'afficher la Frame de selection du planning
Frame1.Visible = True

End Sub

Private Sub Command2_Click()
'****************Bouton QUITTER******************
End
End Sub

Private Sub Form_Load()
erri = Date
'recherche du mois en cours
dateactu = Split(erri, "/")
Option1.Caption = "du mois " & dateactu(1) & "/" & dateactu(2)

'date mois suivant
erri = DateAdd("m", 1, Date)
datemoissuivant = Split(erri, "/")
Option2.Caption = "du mois " & datemoissuivant(1) & "/" & datemoissuivant(2)

'une page blanche par défaut dans le webbrowser (c'est inutile)
WebBrowser1.navigate ("file://" & App.Path & "\PLN\Blanc.HTM")

'chargement du fichier texte de données du mois en cours dans le tableau nommé table
r = ImportTxtFile(App.Path & "\PLN\" & dateactu(1) & ".txt", "<%;%>", table, erri)

List1.Clear
'remplir list box
For i = LBound(table(), 1) To UBound(table(), 1)
List1.AddItem (table(i, 1))
Next i

End Sub

Private Sub Form_Resize()
'condition pour ne pas planter en cas de réduction de l'application
If Form1.Height > 360 Then
Picture1.Top = 1320
Picture1.Height = Form1.Height - 2145
Picture1.Left = 0
Picture1.Width = Form1.Width - 150
VScroll1.Left = Picture1.Width - 250
VScroll1.Height = Picture1.Height
HScroll1.Top = Picture1.Top + Picture1.Height - 250
HScroll1.Width = Picture1.Width - VScroll1.Width
VScroll1.Height = Picture1.Height - HScroll1.Height
End If

End Sub

Private Sub Option1_click()

r = ImportTxtFile(App.Path & "\PLN\" & dateactu(1) & ".txt", "<%;%>", table, erri)

List1.Clear
'remplir list box
For i = LBound(table(), 1) To UBound(table(), 1)
List1.AddItem (table(i, 1))
Next i
End Sub

Private Sub Option2_click()

r = ImportTxtFile(App.Path & "\PLN\" & datemoissuivant(1) & ".txt", "<%;%>", table, erri)

List1.Clear
'remplir list box
For i = LBound(table(), 1) To UBound(table(), 1)
List1.AddItem (table(i, 1))
Next i
End Sub

'****************les barres de défillement***************
Private Sub VScroll1_Change()
WebBrowser1.Top = -VScroll1.Value

End Sub

Private Sub HScroll1_Change()
WebBrowser1.Left = -HScroll1.Value

End Sub

Private Sub List1_Click()
'************************Affichage du planning sélectionné***************

'condition écartant la première valeur de la listbox (valeur nulle)

If List1.ListIndex <> 0 Then

    'masquer l'interface de choix du planning
    Frame1.Visible = False

    'afficher les objets nécessaires à la lecture du planning
    Command1.Visible = True
    Picture1.Visible = True
    VScroll1.Visible = True
    HScroll1.Visible = True
    WebBrowser1.Visible = True
    

    'charger le fichier html
    chemin = "file://" & App.Path & "\" & table(List1.ListIndex, 2)
    WebBrowser1.navigate (chemin)

    'emplacement des objets relatif à la taille de la form
    Call Form_Resize

End If

End Sub

Private Function ImportTxtFile(ByVal fileName As String, ByVal separator As String, ByRef tData() As String, ByRef errorString As String, Optional ByVal baseArray As Integer = 1) As Boolean
Dim f As Integer
Dim tLine() As String
Dim tSplit() As String
Dim buffer As String
Dim nbItem As Long
Dim k As Long, l As Long

    On Error GoTo ImportTxtFile_ERR
    
    f = FreeFile()
    Open fileName For Binary As #f
        buffer = Space$(LOF(f))
        Get #f, , buffer
    Close #f
    tSplit() = Split(buffer, vbCrLf)
    nbItem = UBound(Split(tSplit(0), separator)) + baseArray
    
    ReDim tData(UBound(tSplit()) + baseArray, nbItem)
    
    For k = LBound(tSplit()) To UBound(tSplit())
         tLine = Split(tSplit(k), separator)
        For l = LBound(tLine) To UBound(tLine)
            tData(k + baseArray, l + baseArray) = tLine(l)
        Next l
    Next k
    ImportTxtFile = True

ImportTxtFile_END:
    Exit Function
    
ImportTxtFile_ERR:
    errorString = Err.Description
    Resume ImportTxtFile_END
End Function

Conclusion :


mouhaha mon commentaire est plus long que le code.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (gnieark)