1gazelle
Messages postés24Date d'inscriptionmardi 8 mars 2005StatutMembreDernière intervention24 mars 2005
-
8 mars 2005 à 12:27
cs_jordinette
Messages postés134Date d'inscriptionmercredi 2 mars 2005StatutMembreDernière intervention 5 avril 2007
-
8 mars 2005 à 13:03
bonjour tout le monde!!
je dois à partir d'un document excel contenant plusieurs feuilles, générer un document .csv contenant toutes les données afin de les transferer dans une BD access.
j'ai recupere les fonction "fExportCommaDelimitedFile" sur internet et j'ai ecris qqlignes de code afin de l'appeler en parcourant outes les feuilles.
mais ces qq lignes de code ne marche pas....
l'erreur, en rose, est acconpagner du messsgae "objet requis"
ai-je besoin d'un with...?
with quoi?
merci a tout les lecteurs
Julie
Private Sub BtOK_Click()
Dim temp As Boolean
Dim Resultat As Boolean
Dim i As Long
Dim Feuille As Worksheet
Resultat = True
For i = 1 To Worksheet.Count
Feuille = Worksheets(i)
temp = fExportCommaDelimitedFile(Feuille, "Donnees.csv") If temp False Then Resultat False
Next i
If (Resultat = False) Then
MsgBox ("Erreur lors du la creation du fichier csv")
End If
End Sub
'*********************** Code Start ***************************
Function fExportCommaDelimitedFile(objSht As Excel.Worksheet, strDestinationFile As String) As Boolean
'*******************************************
'Nom: fExportCommaDelimitedFile (Function)
'But: Écrire une feuille en format CSV
'Auteur: Dev Ashish
'Date: March 10, 1999, 12:21:10 PM
'Called by: Any
'Calls: sAppActivate
'Inputs: objSht - Feuille Excel déjà ouverte, par automation
' strDestinationFile - Chemin de la destionation pour le fichier CSV
'Output: True si tout est correct, false autrement
'*******************************************
Dim intFileNum As Integer
Dim lngColCount As Long
Dim lngTotalColumns As Long
Dim lngTotalRows As Long
Dim lngRowCount As Long
Const conQ = """"
Const conERR_GENERIC = vbObjectError + 2100
intFileNum = FreeFile()
On Error GoTo ErrHandler
'Active l'instance d'Access
Call sAppActivate
'Si le fichier cible existe, demander confirmation avant d'écraser
If Len(Dir(strDestinationFile)) > 0 Then
If MsgBox("The target file specified " & vbCrLf & vbCrLf & strDestinationFile & vbCrLf & vbCrLf & " already exists." _
& vbCrLf & vbCrLf & "Are you sure you want to overwrite it?", vbQuestion + vbYesNo, "Please confirm") = vbYes Then
Kill strDestinationFile
Else
Err.Raise conERR_GENERIC
End If
End If
'Créer le fichier CSV
Open strDestinationFile For Output As #intFileNum
With objSht
'Déterminer le nombre de colonnes
lngTotalColumns = .UsedRange.Columns.Count
'Déterminer le nombre de lignes
lngTotalRows = .UsedRange.Rows.Count
'Initialiser le thermomètre de progression
Call SysCmd(acSysCmdInitMeter, "Writing CSV file...", lngTotalRows)
'Traverser toutes les lignes
For lngRowCount = 1 To lngTotalRows
' et chaque colonne
For lngColCount = 1 To lngTotalColumns
' Écrire le texte de la cellule, avec guillements
Print #intFileNum, conQ & RTrim$(.Cells(lngRowCount, lngColCount).Value) & conQ;
' Vérifier si c'est la dernière colonne
If lngColCount = lngTotalColumns Then
'la fin
Print #intFileNum,
Else
' autrement, ajouter une virgule
Print #intFileNum, ",";
End If
Next lngColCount
Call SysCmd(acSysCmdUpdateMeter, lngRowCount)
'Ne pas mobiliser le CPU
DoEvents
Next lngRowCount
End With
fExportCommaDelimitedFile = True
ExitHere:
On Error Resume Next
Call SysCmd(acSysCmdRemoveMeter)
Close #intFileNum
Exit Function
ErrHandler:
fExportCommaDelimitedFile = False
Resume ExitHere
End Function
Private Sub sAppActivate()
'Active l'intance d'Access
'
Dim strCaption As String
On Error Resume Next
strCaption = Application.CurrentDb.Properties("AppTitle")
If Err Then strCaption = "Microsoft Access"
AppActivate strCaption
End Sub
'*********************** Code End ***************************
