Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Besoin d'aide sur une partie de ma fonction

Besoin d'aide sur une partie de ma fonction

1 réponse
Avatar
keawee
Bonjour,

J'aurais besoin de votre =E9claircissement sur un probl=E8me=20
que je rencontre.

J'ai deux requ=EAtes qui vont s'ins=E9rer dynamiquement dans=20
Excel.=20

Ma premi=E8re requ=EAte:

Je sais que mes donn=E9es vont commencer en A3 et qu'elles=20
vont se terminer en A20. La ligne A3:A65000 est le titre=20
de chaque colonne et les colonnes A3:A20 correspondent =E0=20
des champs au format texte et ce sont mes en-t=EAtes de=20
ligne.=20

Lors du transfert de mes donn=E9es en Access et Excel,=20
Excel ne conna=EEtra pas =E0 l'avance le nombre de colonne=20
que vais trouver apr=E8s la colonne A. Je peux avoir 1=20
colonne =E0 XXXXXX colonnes.

Ma deuxi=E8me requ=EAte:
C'est la m=EAme chose que la premi=E8re requ=EAte sauf que je=20
n'aurais qu'une seule ligne d'enregistrements. Cette=20
requ=EAte sera plac=E9e dans la ligne en B22

Je souhaiterais utiliser mon code ci-dessous, mais il y a=20
une partie sur laquelle je bloque. J'ai plac=E9 ma variable=20
Rg B24. Comment faire une boucle pour dire si ma cellule=20
B3 n'est pas vide(si il existe un nom de colonne) alors=20
fais (B14/B22)*100 puis si ma cellule C3 n'est pas vide=20
alors fais (C14/C22)*100 puis si ma cellule D3 est vide=20
alors arr=EAte-toi et laisse vide la cellule ou tu es c'est-
=E0-dire la D24. Je ne sais pas passer de cellule =E0 cellule=20
par du code c'est-=E0-dire de passer de C24 =E0 C25 et ainsi=20
de suite en v=E9rifiant si dans ma cellule C3 j'ai quelque=20
chose et si oui je fais la calcul puis je passe =E0 la=20
cellule suivante et si non j'arr=EAte

Pourriez-vous m'=E9claircir sur se probl=E8me.

Private Sub DataTransfertToExcelInstallBaseTotal()
=20
Dim db As Variant
Dim rs As Variant
Dim fichier As Variant
Dim stAppName As String
=20
fichier =3D Application.CurrentProject.Path
=20
Set db =3D DBEngine.OpenDatabase(fichier=20
& "\ProductPerformance.mdb")
Set rs =3D db.OpenRecordset("Board Install Base +=20
Total", dbOpenDynaset)

Dim XL_App As Object
Set XL_App =3D CreateObject("Excel.Application")
Dim XL_classeur As Object
Dim XL_feuille As Object
Dim Rg As Range
Dim Nb As Long
Dim Sh As Worksheet
=20
With XL_App
Set XL_classeur =3D .Workbooks.Open(fichier=20
& "\GPPR_POP.xls")
Set Sh =3D XL_classeur.Sheets("Install Base")
=20
With Sh
Set Rg =3D .Range("A7").End(xlDown).Offset(4, 2)
End With
=20
Rg.CurrentRegion.Clear
=20
'//\\ -->C'est ici que je bloque !!!!!
=20
.DisplayAlerts =3D False
.ActiveWorkbook.SaveAs fichier=20
& "\GPPR_POP.xls"
.ActiveWorkbook.Close
.DisplayAlerts =3D True
.Quit
End With
db.Close
Set XL_App =3D Nothing
Set XL_classeur =3D Nothing
Set XL_feuille =3D Nothing

End Sub

Merci de votre aide

Keawee
Signaler un problème avec ce contenu

1 réponse

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
michdenis
Toute légère modification....dans le bas de la procédure !

'------------------------------------------------------
Private Sub DataTransfertToExcelInstallBaseTotal()

Dim db As dao.Database, Rs As dao.Recordset
Dim Fichier As String, Nb As Long, Sh As Object
Dim XL_App As Object, XL_classeur As Object
Dim XL_feuille As Object, Rg As Object
Dim A as Long

Fichier = Application.CurrentProject.path

Set db = CurrentDb()
Set Rs = db.OpenRecordset("Employés", dbOpenDynaset)
Rs.MoveFirst
Rs.MoveLast
'Un test pour savoir si le recordset possède des enregistrements.

Nb = Rs.RecordCount
If Nb > 0 Then

'si oui, ouverture de l'application excel et de son classeur
Set XL_App = CreateObject("Excel.Application")

With XL_App
.Visible = True 'Rend l'application Excel visible
Set XL_classeur = .Workbooks.Open(Fichier & "GPPR_POP.xls")
'Assure toi que le nom de la feuille existe...
Set Sh = XL_classeur.Sheets("Install Base")

With Sh
Set Rg = .Range("A7") '.End(xlDown).Offset(4, 2)
End With

'Efface les données déjà présentes dans la plage de réception
'des données de la feuille de calcul.
Rg.CurrentRegion.Clear

'Pour inscrire le nom des champs de ta table dans excel
For A = 0 To Rs.Fields.Count - 1
Rg(1, A + 1) = Rs(A).Name
Next

'copie les données du recordset vers excel
Rs.MoveFirst
For A = 0 To Nb - 1
Rg(A + 2, 1) = Rs(0)
Rg(A + 2, 2) = Rs(1)
Rg(A + 2, 3) = Rs(2)
Rg(A + 2, 4) = Rs(3)
' and so on ...pour le nombre de champs de ta table.
Rs.MoveNext
Next

'Ferme le classeur et l'enregistre
XL_classeur.Close True
'ferme l'instance d'excel
.Quit
End With

'Libère la mémoire des objets "Excel"
Set Rg = Nothing: Set Sh = Nothing
Set XL_classeur = Nothing: Set XL_App = Nothing
Else
MsgBox "opération annulée. pas d'enregistrements"
End If

'Ferme le recordset et la table
Rs.Close: db.Close
'Libère la mémoire
Set Rs = Nothing: Set db = Nothing

End Sub
'------------------------------------------------------


Salutations!



"michdenis" a écrit dans le message de news:

Bonsoir keawee,

J'ai modifié un peu ta procédure. Comme ta macro est écrite directement dans Access, on peut abréger la présentation de
DAO.

Si tu observes attentivement, j'ai désactivé la dernière partie de cette ligne de code dans la macro :

Set Rg = .Range("A7") '.End(xlDown).Offset(4, 2) <--cette section
à toi d'y voir selon ton application...

Peut être que tu n'aimeras pas cette ligne de code, si ta plage recevant les données n'est pas entouré d'une ligne ou
colonne vide, cela risque d'effacer plus de données que tu peux le désirer ... ??

Rg.CurrentRegion.Clear


'------------------------------------------------------
Private Sub DataTransfertToExcelInstallBaseTotal()

Dim db As dao.Database, Rs As dao.Recordset
Dim Fichier As Variant, Nb As Long, Sh As Object
Dim XL_App As Object, XL_classeur As Object
Dim XL_feuille As Object, Rg As Object

Fichier = Application.CurrentProject.path

Set db = CurrentDb()
Set Rs = db.OpenRecordset("Employés", dbOpenDynaset)
Rs.MoveFirst
Rs.MoveLast
'Un test pour savoir si le recordset possède des enregistrements.

Nb = Rs.RecordCount
If Nb > 0 Then

'si oui, ouverture de l'application excel et de son classeur
Set XL_App = CreateObject("Excel.Application")

With XL_App
.Visible = True
Set XL_classeur = .Workbooks.Open(Fichier & "GPPR_POP.xls")
'Assure toi que le nom de la feuille existe...
Set Sh = XL_classeur.Sheets("Install Base")

With Sh
Set Rg = .Range("A7") '.End(xlDown).Offset(4, 2)
End With

Rg.CurrentRegion.Clear

'Pour inscrire le nom des champs de ta table dans excel
For A = 0 To Rs.Fields.Count - 1
Rg(1, A + 1) = Rs(A).Name
Next

'copie les données du recordset vers excel
Rs.MoveFirst
For A = 0 To Nb - 1
Rg(A + 2, 1) = Rs(0)
Rg(A + 2, 2) = Rs(1)
Rg(A + 2, 3) = Rs(2)
Rg(A + 2, 4) = Rs(3)
' and so on ...pour le nombre de champs de ta table.
Rs.MoveNext
Next

XL_classeur.Close True
.Quit
End With
Set Rg = Nothing: Set Sh = Nothing
Set XL_classeur = Nothing: Set XL_App = Nothing

Rs.Close: db.Close
Set Rs = Nothing: Set db = Nothing
Else
MsgBox "opération annulée. pas d'enregistrements"
End If
End Sub
'------------------------------------------------------


Salutations!


P.S. Un jour va bien falloir que tu t'y mettes à ADO ....;-))




"keawee" a écrit dans le message de news:0b3501c3789f$c211b760$

Bonjour,

J'aurais besoin de votre éclaircissement sur un problème
que je rencontre.

J'ai deux requêtes qui vont s'insérer dynamiquement dans
Excel.

Ma première requête:

Je sais que mes données vont commencer en A3 et qu'elles
vont se terminer en A20. La ligne A3:A65000 est le titre
de chaque colonne et les colonnes A3:A20 correspondent à
des champs au format texte et ce sont mes en-têtes de
ligne.

Lors du transfert de mes données en Access et Excel,
Excel ne connaîtra pas à l'avance le nombre de colonne
que vais trouver après la colonne A. Je peux avoir 1
colonne à XXXXXX colonnes.

Ma deuxième requête:
C'est la même chose que la première requête sauf que je
n'aurais qu'une seule ligne d'enregistrements. Cette
requête sera placée dans la ligne en B22

Je souhaiterais utiliser mon code ci-dessous, mais il y a
une partie sur laquelle je bloque. J'ai placé ma variable
Rg B24. Comment faire une boucle pour dire si ma cellule
B3 n'est pas vide(si il existe un nom de colonne) alors
fais (B14/B22)*100 puis si ma cellule C3 n'est pas vide
alors fais (C14/C22)*100 puis si ma cellule D3 est vide
alors arrête-toi et laisse vide la cellule ou tu es c'est-
à-dire la D24. Je ne sais pas passer de cellule à cellule
par du code c'est-à-dire de passer de C24 à C25 et ainsi
de suite en vérifiant si dans ma cellule C3 j'ai quelque
chose et si oui je fais la calcul puis je passe à la
cellule suivante et si non j'arrête

Pourriez-vous m'éclaircir sur se problème.

Private Sub DataTransfertToExcelInstallBaseTotal()

Dim db As Variant
Dim rs As Variant
Dim fichier As Variant
Dim stAppName As String

fichier = Application.CurrentProject.Path

Set db = DBEngine.OpenDatabase(fichier
& "ProductPerformance.mdb")
Set rs = db.OpenRecordset("Board Install Base +
Total", dbOpenDynaset)

Dim XL_App As Object
Set XL_App = CreateObject("Excel.Application")
Dim XL_classeur As Object
Dim XL_feuille As Object
Dim Rg As Range
Dim Nb As Long
Dim Sh As Worksheet

With XL_App
Set XL_classeur = .Workbooks.Open(fichier
& "GPPR_POP.xls")
Set Sh = XL_classeur.Sheets("Install Base")

With Sh
Set Rg = .Range("A7").End(xlDown).Offset(4, 2)
End With

Rg.CurrentRegion.Clear

'// -->C'est ici que je bloque !!!!!

.DisplayAlerts = False
.ActiveWorkbook.SaveAs fichier
& "GPPR_POP.xls"
.ActiveWorkbook.Close
.DisplayAlerts = True
.Quit
End With
db.Close
Set XL_App = Nothing
Set XL_classeur = Nothing
Set XL_feuille = Nothing

End Sub

Merci de votre aide

Keawee