Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Copie données d'un classeur actif à un classeur fermé avec incré me

Copie données d'un classeur actif à un classeur fermé avec incré me

2 réponses
Avatar
thierry
Bonjour à tous,

Je souhaite copier les données d'une feuille active vers une feuille d'un
classeur fermé avec incrémentation.
J'ai assigné la macro à un bouton, et je voudrais que à chque fois que je
cliques sur le bouton, les données de la feuille active viennent s'ajouter à
la suite des données du classeur fermé cible (database.xls dans mon exemple).


Ci dessous: le code que j'utilise (d'après un post précédent)

Un grand merci d'avance!

THierry

Dim oConn As ADODB.Connection
Dim oCmd As ADODB.Command
Dim oRS As ADODB.Recordset

Sub EcritDatas()

Dim Fich As String, cell As Range

'nom et chemin du classeur fermé
Fich = "C:\tcs\mounted_inspection\database.xls" '

'Crée un objet connection ...
Set oConn = CreateObject("ADODB.Connection")
' Ouvre une connection vers le classeur fermé
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fich & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"

'écrit dans le classeur fermé la valeur des
'cellules A1:A5 de ce classeur (classeur actif)
For Each cell In ActiveWorkbook.Sheets("TCS INSPECTION
FORM").Range("B9:X26")
SetExternalDatas Fich, "database", cell.Address(0, 0), cell.Text
Next

'Ferme la connection
oConn.Close
'Libère l'expace mémoire
Set oConn = Nothing
Set oCmd = Nothing
Set oRS = Nothing

End Sub
'------------------------------------------
'écrit DataToWrite dans la cellule DestCellAdr
'de la feuille DestFeuille du classeur fermé DestFile
Sub SetExternalDatas(DestFile As String, _
DestFeuille As String, _
DestCellAdr As String, _
DataToWrite As Variant)

Dim RangeDest As String

' Create a command object and set its ActiveConnection
Set oCmd = CreateObject("ADODB.Command")
oCmd.ActiveConnection = oConn

' This SQL statement selects a cell range in the "feuil2" worksheet.
'1 Sélection pour écrire dans une seule cellule
RangeDest = DestCellAdr & ":" & DestCellAdr
oCmd.CommandText = "SELECT * from `" & DestFeuille & "$" & RangeDest & "`"

' Open a recordset containing the worksheet data.
Set oRS = CreateObject("ADODB.Recordset")
oRS.Open oCmd, , 1, 3 'adOpenKeyset, adLockOptimistic

' Update last row
oRS(0).Value = DataToWrite
oRS.Update
End Sub
Private Sub CommandButton1_Click()
EcritDatas
End Sub
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Patrick Fredin
Bonjour,

Est-ce qu'il ne serait pas plus simple, dans ta macro, d'ouvrir le fichier
de destination et d'y mettre les données que tu veux y rajouter ?

De toute façon, avec des macros c'est toujours transparent pour
l'utilisateur.

--
Patrick

"thierry" wrote in message
news:
Bonjour à tous,

Je souhaite copier les données d'une feuille active vers une feuille d'un
classeur fermé avec incrémentation.
J'ai assigné la macro à un bouton, et je voudrais que à chque fois que je
cliques sur le bouton, les données de la feuille active viennent s'ajouter
à
la suite des données du classeur fermé cible (database.xls dans mon
exemple).


Ci dessous: le code que j'utilise (d'après un post précédent)

Un grand merci d'avance!

THierry

Dim oConn As ADODB.Connection
Dim oCmd As ADODB.Command
Dim oRS As ADODB.Recordset

Sub EcritDatas()

Dim Fich As String, cell As Range

'nom et chemin du classeur fermé
Fich = "C:tcsmounted_inspectiondatabase.xls" '

'Crée un objet connection ...
Set oConn = CreateObject("ADODB.Connection")
' Ouvre une connection vers le classeur fermé
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fich & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"

'écrit dans le classeur fermé la valeur des
'cellules A1:A5 de ce classeur (classeur actif)
For Each cell In ActiveWorkbook.Sheets("TCS INSPECTION
FORM").Range("B9:X26")
SetExternalDatas Fich, "database", cell.Address(0, 0), cell.Text
Next

'Ferme la connection
oConn.Close
'Libère l'expace mémoire
Set oConn = Nothing
Set oCmd = Nothing
Set oRS = Nothing

End Sub
'------------------------------------------
'écrit DataToWrite dans la cellule DestCellAdr
'de la feuille DestFeuille du classeur fermé DestFile
Sub SetExternalDatas(DestFile As String, _
DestFeuille As String, _
DestCellAdr As String, _
DataToWrite As Variant)

Dim RangeDest As String

' Create a command object and set its ActiveConnection
Set oCmd = CreateObject("ADODB.Command")
oCmd.ActiveConnection = oConn

' This SQL statement selects a cell range in the "feuil2" worksheet.
'1 Sélection pour écrire dans une seule cellule
RangeDest = DestCellAdr & ":" & DestCellAdr
oCmd.CommandText = "SELECT * from `" & DestFeuille & "$" & RangeDest &
"`"

' Open a recordset containing the worksheet data.
Set oRS = CreateObject("ADODB.Recordset")
oRS.Open oCmd, , 1, 3 'adOpenKeyset, adLockOptimistic

' Update last row
oRS(0).Value = DataToWrite
oRS.Update
End Sub
Private Sub CommandButton1_Click()
EcritDatas
End Sub



Avatar
thierry
Bonjour Patrick,

En fait la feuille de saisie sera utilisé par des personnes avec des
connaissances très très limitée en informatique. La feuille et la procédure
se veut donc la plus "use friendly" possible.
Je souhaite donc transférer les données de cette feuille simplifiée vers une
base de données (qui me sert ensuite de source à un tableau croisé dynamique)
Si tu connais un moyen pour rendre la procédure tout aussi transparente tout
en permettant l'incrémentation des données (la copie se faisant a chaque fois
a partir de la première ligne vide), ce serait super!


Merci

Thierry

"Patrick Fredin" wrote:

Bonjour,

Est-ce qu'il ne serait pas plus simple, dans ta macro, d'ouvrir le fichier
de destination et d'y mettre les données que tu veux y rajouter ?

De toute façon, avec des macros c'est toujours transparent pour
l'utilisateur.

--
Patrick

"thierry" wrote in message
news:
Bonjour à tous,

Je souhaite copier les données d'une feuille active vers une feuille d'un
classeur fermé avec incrémentation.
J'ai assigné la macro à un bouton, et je voudrais que à chque fois que je
cliques sur le bouton, les données de la feuille active viennent s'ajouter
à
la suite des données du classeur fermé cible (database.xls dans mon
exemple).


Ci dessous: le code que j'utilise (d'après un post précédent)

Un grand merci d'avance!

THierry

Dim oConn As ADODB.Connection
Dim oCmd As ADODB.Command
Dim oRS As ADODB.Recordset

Sub EcritDatas()

Dim Fich As String, cell As Range

'nom et chemin du classeur fermé
Fich = "C:tcsmounted_inspectiondatabase.xls" '

'Crée un objet connection ...
Set oConn = CreateObject("ADODB.Connection")
' Ouvre une connection vers le classeur fermé
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fich & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"

'écrit dans le classeur fermé la valeur des
'cellules A1:A5 de ce classeur (classeur actif)
For Each cell In ActiveWorkbook.Sheets("TCS INSPECTION
FORM").Range("B9:X26")
SetExternalDatas Fich, "database", cell.Address(0, 0), cell.Text
Next

'Ferme la connection
oConn.Close
'Libère l'expace mémoire
Set oConn = Nothing
Set oCmd = Nothing
Set oRS = Nothing

End Sub
'------------------------------------------
'écrit DataToWrite dans la cellule DestCellAdr
'de la feuille DestFeuille du classeur fermé DestFile
Sub SetExternalDatas(DestFile As String, _
DestFeuille As String, _
DestCellAdr As String, _
DataToWrite As Variant)

Dim RangeDest As String

' Create a command object and set its ActiveConnection
Set oCmd = CreateObject("ADODB.Command")
oCmd.ActiveConnection = oConn

' This SQL statement selects a cell range in the "feuil2" worksheet.
'1 Sélection pour écrire dans une seule cellule
RangeDest = DestCellAdr & ":" & DestCellAdr
oCmd.CommandText = "SELECT * from `" & DestFeuille & "$" & RangeDest &
"`"

' Open a recordset containing the worksheet data.
Set oRS = CreateObject("ADODB.Recordset")
oRS.Open oCmd, , 1, 3 'adOpenKeyset, adLockOptimistic

' Update last row
oRS(0).Value = DataToWrite
oRS.Update
End Sub
Private Sub CommandButton1_Click()
EcritDatas
End Sub