tamtam64

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
    'transforme un range en données html pour email
Function RangetoHTML(rng As Range)
    'definition des variables
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    ' Copy the range and create a workbook to receive the data.
    rng.Copy

...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
    'Fonction qui récupere un vecteur
Function ExtraireVecteur(ByVal Matrice As Variant, Ligne As Long, OneColonne As Boolean) As Variant
    'defintion variables
    Dim i As Long, j As Long
    Dim VaR As Variant
        'extraction
    If OneColonne = False Then
        ReDim VaR(UBound(Matrice, 2))
    End If
    For i = 1 To UBound(Matrice, 1)
        If i = Ligne Then
            If OneColonne = False Then

...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
    'Fais la somme d'une matrice par colonne
Function SumTableau(ByVal MyTab As Variant) As Variant
        'Definition des variables
    Dim i As Long, j As Long
    Dim MyVar As Variant
        'Forcage en vecteur ligne
    ReDim MyVar(1 To 1, 1 To UBound(MyTab, 1))
        'Somme
    For i = 1 To UBound(MyTab, 1)
            For j = 1 To UBound(MyTab, 2)
                MyVar(1, i) = MyVar(1, i) + MyTab(i, j)

...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
    'verifie si la feuille existe ou non
 Function IsExistWorksheet(ByVal xlbook As Workbook, ByVal nom_F As String) As Boolean 'fonction Test
    On Error Resume Next
    IsExistWorksheet = xlbook.Sheets(nom_F).Name <> ""
    On Error GoTo 0
 End Function

    'Test si un wb esxiste deja
 Function IsExisteFolder(ByVal Chemin As String, ByVal NomFichier As String) As Boolean
    Dim folder As New Scripting.FileSystemObject

...

On à souvent besoin de vérifier la date de mise a jour d'un fichier et en avertire si le fichier n'est pas à jour, lors de l'extraction.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
    'verification des donnees
Function Verif(ByVal xlbook As Workbook) As Boolean
        'Déclaration des variables
    Dim Repert1 As Object, Fic1 As Object
    Dim Syst_fic As Object, Fic_acces As Date
    Dim Fic_nom As String, response As Boolean
    
        'On parcourt le dossier

...