Soyez le premier à donner votre avis sur cette source.
Snippet vu 28 756 fois - Téléchargée 36 fois
'-------------------------------------- '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
Il me sert bien dans mes bases Access 97.
Génial !!!
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.