XL 2016 VBA - Code pour écrire une plage dans une feuille d'un classeur fermé

[Dudu2]

Bonjour
Quelqu'un aurait ça dans ses tiroirs ?
Cordialement

P.S. J'ai le code pour lire en classeur fermé besoin.

 

[Dudu2]

Bonjour,
Il me semble que j'ai répondu à cette question en Post #5.

Pour l'exemple disons que ce serait de placer les valeurs "B3" et "B4" dans les cellules B3 et B4 de la feuille "Feuil1" d'un classeur fermé.

Maintenant, je peux te fournir un classeur vide dans lequel "placer les valeurs "B3" et "B4" dans les cellules B3 et B4 de la feuille "Feuil1".

Si la notion d'échantillonnage a un sens différent dans ta formulation, merci de le préciser.
Je suppose qu'il ne s'agit pas d'échantillonnage de population, de chats gris, ou de noix de coco... probabiliste ou pas.

 

[Dudu2]

Et toi @patricktoulon qui semble te marrer comme un baleine à la lecture de la réponse absconse de @dysorthographie, c'est quoi pour toi un "echantillonnage" ?

 

[patricktoulon]

re
@Dudu2
il n'y a pas d'effet de bord
c'est que le recordset comme beaucoup d'autres fonctions excel ne prend que la plage utilisée
donc si tu tape en dessous ben t'est mort

me marrer moi !!?
ben c'est surtout que ça fait un moment que robert te demande un fichier

"echantillonnage"
ben dedans il y a é puis chant puis "illionnage"

ben c'est simple
procédé de petite chanson répétitives

 

[patricktoulon]

re
pour ton probleme de plage plus large tu a 2 solution
la premiere( la plus facile)c'est de mettre une valeur tout en bas a droite de ta base
et de passer non pas en une cellule dans la requete mais dans une plage comprenant ta cellule
bien sur ce ne sera plus le rst(0)

la 2d
tu peux faire une 1ere requete pour savoir si ta cellule est comprise dans la plage
et quoi que!!! en testant msgbox ubound(rst.getrows()) tu sais tout de suite si tu es en dehors de la plage

 

[Dudu2]

Ah ouais, tu t'en sors par une pirouette à la toulonnaise avec ton bulldog favori !

Bon, finalement je sais maintenant écrire dans une cellule d'un fichier fermé si elle est dans le UsedRange.
Certes, ce n'est pas le top, mais je sens que tant que je n'aurai pas fourni d'"échantillonnage" je n'aurai pas davantage.

Alors merci à tous et voilà mon petit code final (voir Post suivant).

 

[Dudu2]

Option Explicit

Sub Test()
    Dim Fichier As String
    Dim Feuille As String
    Dim Cellule As String
    Dim Valeur As Variant
 
    Fichier = "F:\Téléchargements\Classeur1.xlsx"
    Feuille = "Feuil1"
    Cellule = "G3"
    Valeur = "Donnée XX"
 
    Call ÉcrireDansCelluleClasseurFermé(Fichier, Feuille, Cellule, Valeur)
End Sub

'----------------------------------------------------------------------
'Permet d'écrire dans une cellule d'une feuille d'un classeur fermé.
'Attention ! La cellule cible doit être dans le UsedRange de la feuille
'            ou être A1 si la feuille cible est vide.
'----------------------------------------------------------------------
Sub ÉcrireDansCelluleClasseurFermé(Fichier As String, Feuille As String, Cellule As String, Valeur As Variant)
    Dim Cnx As Object
    Dim Cmd As Object
    Dim Rst As Object
    Dim ErrNumber As Long
  
    'Si pas de Reference "Microsoft ActiveX Data Objects x.x Library"
    Const adOpenKeyset = 1
    Const adLockOptimistic = 3

    Set Cnx = CreateObject("ADODB.Connection")
    Cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Fichier & ";" & "Extended Properties=""Excel 12.0;HDR=NO;"""
  
    Set Cmd = CreateObject("ADODB.Command")
    Cmd.ActiveConnection = Cnx
    Cmd.CommandText = "SELECT * FROM [" & Feuille & "$" & Cellule & ":" & Cellule & "]"
  
    Set Rst = CreateObject("ADODB.Recordset")
    On Error Resume Next
    Rst.Open Cmd, , adOpenKeyset, adLockOptimistic
    ErrNumber = Err.Number
    On Error GoTo 0
  
    If ErrNumber = -2147467259 Then
        MsgBox "La cellule <" & Cellule & "> est hors du UsedRange de la feuille <" & Feuille & "> du fichier <" & Fichier & "> " & _
               "et ne peut donc être valorisée par cette fonction !"
        Exit Sub
    End If
  
    Rst(0).Value = Valeur
    Rst.Update
  
    Cnx.Close
    Set Cnx = Nothing
    Set Cmd = Nothing
    Set Rst = Nothing
End Sub

Edit: pour écrire dans un tableau (titres de colonnes requis) d'une feuille d'un classeur fermé, voir aussi le Post #45 qui, basé sur le code de @dysorthographie, généralise la méthode en utilitaire.

 

[dysorthographie]

Je te suggère de passer sur du csv car il faut une base minimum pour écrire dans un fichier fermé. Entête de colonnes facultatif, une ligne de valeurs pour qu'ADO evalu le type de données.

Un classeur vide sa marche pas !

 

[patricktoulon]

re
comme je travaille a99% sur des tabeaux structurés je ne sais pas le faire sur un range normal mais si robert veux bien te l'adapter je te domme mes fonctions

@Dudu2

valeurs pour qu'ADO evalu le type de données.

c'est pour cela que échantillonnage est necessaire
car ado n'aime pas trop les données de type différent
il faut paramétrer

@dysorthographie
si je te donne mes fonctions getlastrow on closedfich tu peux les adapter
a un range classique ????

 

[Dudu2]

@dysorthographie,
Merci pour ta confirmation, en effet dans un classeur vide, qui était mon intention initiale, ça ne fonctionne pas et je pense comprendre en gros pourquoi. C'est donc uns restriction naturelle de la fonction ci-dessus.
Par contre ce que j'aurais aimé c'est pouvoir écrire une plage (fut-elle contigüe et que tout soit en String) plutôt qu'une simple cellule.

 

[patricktoulon]

re
ben finalement j'ai trouvé tout seul il faut juste la feuille en paramètres
le principe est simple
Tiens mon @Dudu2

Sub Dernière_LIgne_Tableau_De_Données_Ds_Classeur_Fermé()
    Dim Fichier$, Table1, X&, Y&
    Fichier = ThisWorkbook.Path & "\recepteur.xlsx"    'chemin du fichier
    Table1 = "[Feuil1$]"    'Nom de la feuille est la colonne (A)
    X = GetLastRow(Fichier, Table1)
    MsgBox "dernière ligne  de la feuille est : " & X
End Sub


Function GetLastRow(ByVal Fichier As String, ByVal TableName As String) As Long
   'patricktoulon
  'remplacer adUseClient  par 3 si pas de ref activx data object activée
    Dim Cn As Object, Rst As Object
    Set Cn = CreateObject("ADODB.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO"";"
    Set Rst = CreateObject("ADODB.RecordSet"): Rst.CursorLocation = adUseClient: Rst.Open TableName, Cn, adOpenStatic
    Rst.MoveLast: GetLastRow = Rst.AbsolutePosition
    Rst.Close: Cn.Close: Set Conn = Nothing: Set Rst = Nothing
End Function

 

[Dudu2]

Ok mon @patricktoulon, je vais me servir de ton GetLastRow, histoire de pas faire de On Error.

 

[patricktoulon]

re
on peu intégrer je crois en une seule sub

 

[Dudu2]

Faudrait que tu la mettes au point. T'as encore pas testé !

Function GetLastRow(ByVal Fichier As String, ByVal TableName As String) As Long
   'patricktoulon
  'remplacer adUseClient  par 3 si pas de ref activx data object activée
    Const adUseClient = 3
    Const adOpenStatic = 3
    
    Dim Cn As Object, Rst As Object
    Set Cn = CreateObject("ADODB.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO"";"
    Set Rst = CreateObject("ADODB.RecordSet"): Rst.CursorLocation = adUseClient: Rst.Open TableName, Cn, adOpenStatic
    Rst.MoveLast: GetLastRow = Rst.AbsolutePosition
    Rst.Close: Cn.Close: Set Cn = Nothing: Set Rst = Nothing
End Function

 

[dysorthographie]

@dysorthographie,
Merci pour ta confirmation, en effet dans un classeur vide, qui était mon intention initiale, ça ne fonctionne pas et je pense comprendre en gros pourquoi. C'est donc uns restriction naturelle de la fonction ci-dessus.
Par contre ce que j'aurais aimé c'est pouvoir écrire une plage (fut-elle contigüe et que tout soit en String) plutôt qu'une simple cellule.

En fait les base de données on des champs typés. Le fait qu'il n'y ai pas de colonnes c'est pas grave car on utilise [F1],[F2], [Etc] pour Field1;2;3...
Je vais vérifier s'il es possible d'intégrer des données dans une feuille vide.

@patricktoulon oui je vais regarder.

 

[patricktoulon]

pas testé!!?
ben chez moi elle fonctionne