Transfert de donnée à partir d'un classeur Excel fermé - il manque la première ligne.

[siocnarf]

Bonjour,

Le but de mon code est de transcrire les données d'un classeur excel vers un autre classeur.

J'ai 2 problèmes:

1. Je ne réussis pas à la première ligne de ma feuille. À mois d'insérer une ligne en haut de ma feuille et d'y mettre des x. Autrement cela ne passe pas.
2. Si une cellule a plus de 8000 caractères alors le programme plante.

Public Sub ConsoDatas(NomFichier$, NomFichierDest$, FeuilleSource$, FeuilleCible$)
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim Li&, FeuilleDest

'Version de Excel
'"12"= Excel 2007
'"11"= Excel 2003
StrVersion = Application.Version

        szConnect = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & NomFichier & ";" & _
            "Extended Properties=""Excel 12.0;HDR=YES;IMEX=1"""
          
    ' La requête est basée sur le nom de la feuille. Ce nom
    ' doit se terminer par un $ et doit être entouré de crochets droits.
    szSQL = "SELECT * FROM [" & FeuilleSource & "$];"

    Set rsData = New ADODB.Recordset
    rsData.Open szSQL, szConnect, adOpenForwardOnly, _
        adLockReadOnly, adCmdText

    
    

    'où envoyer les données :
    Workbooks("consol.xlsx").Activate
    Sheets(FeuilleCible).Select
    myrow = ActiveSheet.UsedRange.Rows.Count
    Set FeuilleDest = ActiveWorkbook.Sheets(FeuilleCible)
    'Quelle est la dernière ligne de la feuille?
    Derniereligne = Rows.Count
    Li = FeuilleDest.Range("A" & Derniereligne).End(xlUp).Row
    'If Li = 2 Then Li = 1 'Je souhaite que la copie se fasse à partir de la première ligne.
    'envoi sur la première ligne vide
    If Not rsData.EOF Then
     FeuilleDest.Range("A" & Li).CopyFromRecordset rsData
    Else
      'si la source était vide...
      MsgBox "Aucun enregistrement renvoyé.", vbCritical
    End If

    ''' On nettoie pour finir...
    rsData.Close
    Set rsData = Nothing

End Sub

Literallement, szconnect se lira ainsi:

"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\temp\a.xlsx;Extended Properties="Excel 12.0;HDR=YES;IMEX=1""

szSQL se lira: "SELECT * FROM [Feuil2$];"

FeuilleDest.Range(A1).CopyFromRecordset rsData

Merci,

François

 

[tbft]

Re : Transfert de donnée à partir d'un classeur Excel fermé - il manque la première l

Bonsoir

Je pense qu'avec un bout de fichier, cela serait plus facile et plus rapide....
Pouvez vous faire le nécessaire,svp?

 

[Pierrot93]

Re : Transfert de donnée à partir d'un classeur Excel fermé - il manque la première l

Bonjour,

un exemple à adapter ci-dessous :

Option Explicit
'necessite d'activer la reference Microsoft ActiveX Data Objects x.x Library
Sub test()
Dim c As Connection, r As Recordset, i As Integer, t()
Set c = New ADODB.Connection
c.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & _
    "C:\MesDocs\Excel\NomClasseur.xls"
Set r = c.Execute("[NomFeuille$A1:B100]") 'ajouter un $ au nom de la feuille
t = Application.Transpose(r.GetRows)
For i = 0 To r.Fields.Count - 1
    Cells(1, i + 1) = r.Fields(i).Name
Next i
Cells(2, 1).Resize(UBound(t, 1), UBound(t, 2)) = t
r.Close
c.Close
Set r = Nothing
Set c = Nothing
End Sub

bonne journée
@+

 

[siocnarf]

Re : Transfert de donnée à partir d'un classeur Excel fermé - il manque la première l

Bonjour,

Alors tel que demandé, en pièce jointe.
Le zip contient 3 fichiers.
- Test.xlsm--> Contient la macro
- Consol.xlsx--> À ouvrir préalablement à l'exécution. Le fichier devrait être vide
- g.xlsx--> Contient 4 lignes de données

Vous remarquerez que:
- La ligne A est omise pour une raison inconnu
- La ligne D fait planter le programme pour la cellule C4. La cellule B4 contient 6792 caractères et la cellule C4 contient 9709 caractères.

1. Mes recherches me font dire que si tôt que l'on dépasse les 8000 caractères, cela plante mais pourquoi??

2. Pourquoi la ligne 1 est omise comme si c'était une entete?



Merci,

François