bonjour a tous

voici une petite fonction que j'ai fait pour m'amuser
cette fonction a pour but de sauver (dans un fichier txt ou csv et même en html )une plage de cellules
jusque la rien de bien transcendant

sauf que cette fonction propose plusieurs paramètres
  1. transposition(ligne/colonne)
  2. création ou mise a jour du fichier
  3. separateur(";",",",vbtab,etc.... ce que vous voulez en fait
  4. et pour finir le format html avec la transposition et la (creation/mise a jour)possible


le tout sans toucher au tableur bien entendu


voici le code la fonction

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Function plage_tO_fiche(RnG, fichier, Optional separ As String = ";", Optional transposition As Boolean = False, Optional mise_a_jour As Boolean = False)
    Dim x As Integer, i As Long, plage As Variant, deblig As String, finlig As String, debtable As String, fintable As String
    If Right(fichier, 5) = ".html" Then
        deblig = "<TR><TD style=""border:1px solid gray;"">"
        finlig = "</TD></TR> "
        separ = "</TD><TD style=""border:1px solid gray;"">"
        debtable = "<table>" & vbCrLf
        fintable = vbCrLf & "</table>"
    End If
    plage = RnG.Value
    x = FreeFile
    If Dir(fichier) = "" Or mise_a_jour = False Then
        Open fichier For Output As #x
    Else
        If mise_a_jour = True Then Open fichier For Append As #x
    End If
    Print #x, debtable
    If transposition = False Then
        For i = 1 To RnG.Row + RnG.Rows.Count - 1    ' de la ligne 1 a a LA DERNIERE
            Print #x, deblig & Join(WorksheetFunction.Index(plage, i, 0), separ) & finlig
        Next
    Else
        For i = 1 To RnG.Column + RnG.Columns.Count - 1    ' de la COLONNE 1 a LA DERNIERE
            Print #x, deblig & Join(Application.Transpose(WorksheetFunction.Index(plage, 0, i)), separ) & finlig
        Next
    End If
    Print #x, fintable
    Close #x
End Function
voici quelques exemple d'utilisation chaque sub a le commentaire qui dit ce qu'elle fait
'exemple de création de fichier text basé sur une plage de cellules et separateur perso avec test d'existance du fichier (creation et/ou ajout)
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
Option Explicit
Sub test1()
   'enregistre la plage transposée avec le separateur classique ";" dans un fichier txt
   'remplace le fichier si il existe
    Dim fichier As String
    fichier = "C:\Users\polux\Desktop\ttt.txt"
    plage_tO_fiche Range("A1:E10"), fichier, transposition:=True
End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
Sub test2()
    ' 'enregistre la plage tel quel dans un fichier"txt",on peut mettre le separateur que l'on veux ";" si omis ici en l'occurence j'utilise le tab pour separateur
    'remplace le fichier si il existe
    Dim fichier As String
    fichier = "C:\Users\polux\Desktop\ttt.txt"
    plage_tO_fiche Range("A1:E10"), fichier, separ:=vbTab
End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
Sub test3()
    'remplace le fichier si il existe création si il n'existe pas vbtab comme séparateur 
    Dim fichier As String
    fichier = "C:\Users\polux\Desktop\ttt.txt"
    plage_tO_fiche Range("A1:E10"), fichier, separ:=vbTab
End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
Sub test4()
    'met a jour le fichier si il existe
    Dim fichier As String
    fichier = "C:\Users\polux\Desktop\ttt.txt"
    plage_tO_fiche Range("A1:E10"), fichier, separ:=vbTab, mise_a_jour:=True
End Sub

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
Sub test5()
    'met a jour le fichier si il existe ,la plage sera enregistrée transposée vbtab comme séparateur 
    Dim fichier As String
    fichier = "C:\Users\polux\Desktop\ttt.txt"
    plage_tO_fiche Range("A1:E10"), fichier, separ:=vbTab, mise_a_jour:=True, transposition:=True
End Sub
'et enfin le format html
' bien entendu les parametres( "mise_a_jour","transposition") sont valables aussi pour ce format
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
Sub test6HTML()
    Dim fichier As String
    fichier = "C:\Users\polux\Desktop\ttt.html"
    plage_tO_fiche Range("A1:E10"), fichier, mise_a_jour:=True
End Sub
qu'en pensez vous ?