Macros excel pour les fichiers csv

Soyez le premier à donner votre avis sur cette source.

Snippet vu 28 502 fois - Téléchargée 36 fois

Commenter

Contenu du snippet

Deux petites fonctions + Api de microsoft pour commondialog.
1) McExportCSV :
Exporte au format CSV en se basant sur le format de la cellule. Si c'est
du texte il met "C'est du texte" !!

2) mcOuvreCsv :
Ouvre un fichier CSV. Part du principe que si le texte est entre double quote ("), c'est du texte !!

3) clsCommonDialogAPI(c'est un module de classe à part...)
De microsoft... j'ai modifié deux trois trucs...

@ bientôt, Vic

Source / Exemple : 


'--------------------------------------
'McExportCSV
'
Sub McExportCSV()
    Dim objF            As Worksheet
    Dim lngCellules     As Long
    Dim lngColonnes     As Long
    Dim i               As Long
    Dim R               As Range
    Dim j               As Long
    Dim fCond           As FormatCondition
    Dim strCSV          As String
    Dim sPath           As String
    
    Set objF = Excel.ActiveSheet
    
    sPath = ThisWorkbook.Path & "\" & objF.Name & ".csv"
    
    lngColonnes = objF.UsedRange.Columns.Count
    lngCellules = objF.UsedRange.Rows.Count
    
    For i = 1 To lngCellules
        For j = 1 To lngColonnes
            Set R = objF.Cells(i, j)
            If R.NumberFormat = "@" Then
                strCSV = strCSV & Chr(34) & R.Value & _
                Chr(34) & IIf(j < lngColonnes, ";", "")
            Else
                strCSV = strCSV & IIf(R.NumberFormat <> _
                "General", Format(R.Value, R.NumberFormat), _
                R.Value) & IIf(j < lngColonnes, ";", "")
            End If
        Next
        strCSV = strCSV & IIf(i < lngCellules, vbCrLf, "")
    Next
    
    If Len(strCSV) > 0 Then
        Open sPath For Output As #1
        Print #1, strCSV
        Close #1
        MsgBox "L'exportation c'est bien déroulé"
    Else
        MsgBox "Il n'y a aucune donnée dans la feuille active"
    End If
    
    Set R = Nothing
    Set fCond = Nothing
    Set objF = Nothing
    
End Sub

'--------------------------------------
'mcOuvreCsv
'
Sub mcOuvreCsv()
    Dim Cdlg            As New clsCommonDialogAPI
    Dim lngFormHwnd     As Long
    Dim lngAppInstance  As Long
    Dim strInitDir      As String
    Dim strFileFilter   As String
    Dim strDialogName   As String
    Dim sPath           As String
    Dim lngResult       As Long
    Dim sLigne          As String
    Dim sTableau()      As String
    Dim objF            As Worksheet
    Dim R               As Range
    Dim fCond           As FormatCondition
    Dim i               As Integer
    Dim j               As Integer
    
    strInitDir = "C:\"
    
    strFileFilter = "Fichier CSV (*.csv)" & _
            Chr(0) & "*.csv" & Chr(0)
    
    strDialogName = "Importer un fichier CSV"
    
    lngResult = Cdlg.OpenFileDialog(lngFormHwnd, _
            lngAppInstance, strInitDir, strFileFilter, _
            strDialogName)
    
    If Cdlg.GetStatus = True Then
        sPath = Cdlg.GetName
        
        Set objF = ThisWorkbook.ActiveSheet
        
        Open sPath For Input As #1
        
        i = 0
        
        Do While Not EOF(1)
            Line Input #1, sLigne
            sTableau = Split(sLigne, ";")
            i = i + 1   'nouvelle ligne
            
            For j = 0 To UBound(sTableau)
                
                objF.Cells(i, j + 1).Value = _
                Replace(sTableau(j), """", "")
                
                If InStr(sTableau(j), """") > 0 Then
                    Set R = objF.Cells(i, j + 1)
                    R.NumberFormat = "@"
                Else
                
                End If
            Next
            
        Loop
        
        Close #1
        Set Cdlg = Nothing
        Set objF = Nothing
        Set R = Nothing
        Set fCond = Nothing
        
    Else
        MsgBox "Aucun fichier sélectionné..."
    End If
    
End Sub

'----------------------------------------------------------
'
'     DANS UN MODULE DE CLASSE : clsCommonDialogAPI
'----------------------------------------------------------

Option Explicit

Private Declare Function GetOpenFileName Lib _
    "comdlg32.dll" Alias "GetOpenFileNameA" _
    (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib _
    "comdlg32.dll" Alias "GetSaveFileNameA" _
    (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private mstrFileName As String
Private mblnStatus As Boolean

Public Property Let GetName(strName As String)
    mstrFileName = strName
End Property

Public Property Get GetName() As String
    GetName = mstrFileName
End Property

Public Property Let GetStatus(blnStatus As Boolean)
    mblnStatus = blnStatus
End Property

Public Property Get GetStatus() As Boolean
    GetStatus = mblnStatus
End Property

Public Function OpenFileDialog(lngFormHwnd As Long, _
    lngAppInstance As Long, strInitDir As String, _
    strFileFilter As String, Optional strOpenDialogName As String = _
"Ouvrir un fichier") As Long

    Dim OpenFile As OPENFILENAME
    Dim X As Long
    
    With OpenFile
        .lStructSize = Len(OpenFile)
        .hwndOwner = lngFormHwnd
        .hInstance = lngAppInstance
        .lpstrFilter = strFileFilter
        .nFilterIndex = 1
        .lpstrFile = String(257, 0)
        .nMaxFile = Len(OpenFile.lpstrFile) - 1
        .lpstrFileTitle = OpenFile.lpstrFile
        .nMaxFileTitle = OpenFile.nMaxFile
        .lpstrInitialDir = strInitDir
        .lpstrTitle = strOpenDialogName
        .Flags = 0
    End With
        
    X = GetOpenFileName(OpenFile)
    If X = 0 Then
        mstrFileName = "none"
        mblnStatus = False
    Else
        mstrFileName = Trim(OpenFile.lpstrFile)
        mblnStatus = True
    End If
End Function

Public Function SaveFileDialog(lngFormHwnd As Long, _
    lngAppInstance As Long, strInitDir As String, _
    strFileFilter As String) As Long

    Dim SaveFile As OPENFILENAME
    Dim X As Long
            
    With SaveFile
        .lStructSize = Len(SaveFile)
        .hwndOwner = lngFormHwnd
        .hInstance = lngAppInstance
        .lpstrFilter = strFileFilter
        .nFilterIndex = 1
        .lpstrFile = String(257, 0)
        .nMaxFile = Len(SaveFile.lpstrFile) - 1
        .lpstrFileTitle = SaveFile.lpstrFile
        .nMaxFileTitle = SaveFile.nMaxFile
        .lpstrInitialDir = strInitDir
        .lpstrTitle = "Save File"
        .Flags = 0
    End With
        
    X = GetSaveFileName(SaveFile)
    If X = 0 Then
        mstrFileName = "none"
        mblnStatus = False
    Else
        mstrFileName = Trim(SaveFile.lpstrFile)
        mblnStatus = True
    End If
End Function

Conclusion :


Voilà ma contribution dominicale, @ Bientôt.

A voir également

Ajouter un commentaire

Commentaire

Signaler
Fabio972
Messages postés
62
Date d'inscription
dimanche 22 octobre 2000
Statut
Membre
Dernière intervention
4 août 2004
 -
Merci Vic d'avoir mis ce code ici.
Il me sert bien dans mes bases Access 97.

Génial !!!
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 (VicoLaChips2)