Transfert en bloc depuis un classeur fermé (ADO)

Est ce qu'on peut sous un seul appel de fonction transférer les valeurs d'un bloc de cellules "source"sur un classeur fermé à un bloc de cellules "cible" ?

Il est possible de lire et de récupérer des plages entières de cellules dans un classeur fermé en utilisant les objets ADO (ActiveX Data Objects). Ci-dessous un exemple de code fonctionnel, à recopier dans un module standard du VBAProject de ton classeur "cible". Ce classeur "cible" doit comporter une référence à la bibliothèque Microsoft ActiveX Data Objects 2.x Library. C'est la procédure GetExternalData qui fait le travail. La procédure LitDatas se contente de l'appeler en lui passant les paramètres voulus et en renvoyant les données récupérées à l'endroit voulu.

sub LitDatas()
 Dim Fich$, Arr
 
 Fich = "D:\TestDataToRead.xls"
 'récup des données à partir de l'adresse d'une plage de cellules
 GetExternalData Fich, "Feuil1", "A10:G20", False, Arr
 'récup des données à partir du nom d'une plage de cellules
 ' GetExternalData Fich, "", "essainom", False, Arr
 With ThisWorkbook.Sheets("Feuil1")
  .Range("A1", .Cells(UBound(Arr, 1), UBound(Arr, 2))).Value = Arr
 End With
 
 end sub

renvoie les valeurs d'une plage de cellules (srcRange) d'une feuille (srcSheet) d'un fichier (srcFile) fermé dans un tableau (outArr) le paramètre TTL indique si la plage a ou non une ligne d'entêtes

sub GetExternalData(srcFile As String, _
          srcSheet As String, _
          srcRange As String, _
          TTL As Boolean, _
          outArr As Variant)
 'd'après Héctor Miguel, mpep
 Dim myConn As ADODB.Connection, myCmd As ADODB.Command
 Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer
 Dim Arr
 
 Set myConn = New ADODB.Connection
 If TTL = True Then HDR = "Yes" Else HDR = "No"
 myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
       "Data Source=" & srcFile & ";" & _
       "Extended Properties=""Excel 8.0;" & _
       "HDR=" & HDR & ";IMEX=1;"""
 Set myCmd = New ADODB.Command
 myCmd.ActiveConnection = myConn
 If srcSheet = "" _
  Then myCmd.CommandText = "SELECT * from `" & srcRange & "`" _
  Else myCmd.CommandText = "SELECT * from `" & srcSheet & "$" & srcRange & "`"
 Set myRS = New ADODB.Recordset
 myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
 ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
 myRS.MoveFirst
 Do While Not myRS.EOF
  For RS_n = 1 To myRS.RecordCount 'lignes
   For RS_f = 0 To myRS.Fields.Count - 1 'colonnes
    Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
   Next
   myRS.MoveNext
  Next
 Loop
 myConn.Close
 Set myRS = Nothing
 Set myCmd = Nothing
 Set myConn = Nothing
 
 outArr = Arr
 
 end sub

Auteur :

Mots clefs associés à cette page : , , , , , , , ,