Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Access Aide sur Formatage de Excel par Access

Aide sur Formatage de Excel par Access

1 réponse
Avatar
keawee
Bonjour,=20

J'ai des petits probl=E8me sur ma fonction. J'arrive =E0=20
envoyer et formater mes donn=E9es vers Excel mais je=20
n'arrive pas =E0 g=E9rer le PageSetUp en VBA. Il refuse.=20
Pourriez vous m'aider.=20

Je souhaite mettre les lignes de 1 =E0 6 en ligne =E0 r=E9p=E9ter=20
en haut de ma feuille Excel et je n'y arrive pas =E0 le=20
faire.=20

Je n'arrive pas =E0 mettre ma feuille Excel au format=20
paysage et en 80%=20

Je n'arrive pas =E0 fixer des marges=20

et je n'arrive pas =E0 mettre le titre de mes champs avec=20
un fond gris comme ceci:=20

Code:=20
Rg.Resize(, Nb + 1).BackColor =3D 12=20


Mon Code:=20

Private Sub DataTransfertToExcelRegion1()=20

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

fichier =3D Application.CurrentProject.Path=20

Set db =3D DBEngine.OpenDatabase(fichier & "\RI=20
Facturable.mdb")=20
Set rs =3D db.OpenRecordset("SV - RTR - R=E9gion 1",=20
dbOpenDynaset)=20



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

With XL_App=20
Set XL_classeur =3D .Workbooks.Open(fichier=20
& "\RI Facturable.xls")=20
Set Sh =3D XL_classeur.Sheets("R=E9gion 1")=20

With Sh=20
Set Rg =3D .Range("A6")=20
End With=20

Rg.CurrentRegion.Clear=20

If rs.EOF =3D False Then=20
Nb =3D rs.Fields.Count - 1=20

For a =3D 0 To Nb=20
Rg(, 1 + a) =3D rs.Fields(a).Name=20
Next=20
Rg.Resize(, Nb + 1).Font.Bold =3D True
Rg.Resize(, Nb + 1).BackColor =3D 12 =20
Rg.Offset(1).CopyFromRecordset rs=20
Rg.CurrentRegion.EntireColumn.AutoFit=20
Rg.CurrentRegion.WrapText =3D True=20
Rg.CurrentRegion.BorderAround bordure,=20
xlHairline, 0=20
Rg.CurrentRegion.Borders.LineStyle =3D=20
xlContinuous=20
Rg.CurrentRegion.HorizontalAlignment =3D=20
xlHAlignCenter=20
Rg.CurrentRegion.VerticalAlignment =3D=20
xlVAlignCenter=20

Else=20
MsgBox "Aucun enregistrement trouv=E9."=20
End If=20

With Sh
Sh.PageSetup.CenterHorizontally =3D True=20
Sh.PageSetup.PrintTitleRows =3D ActiveSheet.Rows
("1:3").Address=20
Sh.PageSetup.PrintArea =3D Sh.Range
("A6").CurrentRegion.Address=20
End With


.DisplayAlerts =3D False=20
.ActiveWorkbook.SaveAs fichier & "\RI=20
Facturable.xls"=20
.ActiveWorkbook.Close=20
.DisplayAlerts =3D True=20
.Quit=20

End With=20

db.Close=20
XL_App.Quit=20
Set XL_App =3D Nothing=20
Set XL_classeur =3D Nothing=20
Set XL_feuille =3D Nothing=20

End Sub=20


Merci de votre aide=20

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
Raymond
Bonsoir.

sans décortiquer ta procédure j'ai l'impression que tu as fait sauter tous
les points (.) avant tes ordres excel.
tu mets un with et pas de fonctions avec le point comme ici:
Rg.Resize(, Nb + 1).Font.Bold = True
sans le point ta fonction s'adresse à access et non à un objet de ton
application excel.
--
@+
Raymond Access MVP.
http://access.seneque.free.fr/
http://users.skynet.be/mpfa/charte.htm pour une meilleure
efficacité de tes interventions sur MPFA.


"keawee" a écrit dans le message de
news:062101c37d55$49901f60$
Bonjour,

J'ai des petits problème sur ma fonction. J'arrive à
envoyer et formater mes données vers Excel mais je
n'arrive pas à gérer le PageSetUp en VBA. Il refuse.
Pourriez vous m'aider.

Je souhaite mettre les lignes de 1 à 6 en ligne à répéter
en haut de ma feuille Excel et je n'y arrive pas à le
faire.

Je n'arrive pas à mettre ma feuille Excel au format
paysage et en 80%

Je n'arrive pas à fixer des marges

et je n'arrive pas à mettre le titre de mes champs avec
un fond gris comme ceci:

Code:
Rg.Resize(, Nb + 1).BackColor = 12


Mon Code:

Private Sub DataTransfertToExcelRegion1()

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 & "RI
Facturable.mdb")
Set rs = db.OpenRecordset("SV - RTR - Région 1",
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
& "RI Facturable.xls")
Set Sh = XL_classeur.Sheets("Région 1")

With Sh
Set Rg = .Range("A6")
End With

Rg.CurrentRegion.Clear

If rs.EOF = False Then
Nb = rs.Fields.Count - 1

For a = 0 To Nb
Rg(, 1 + a) = rs.Fields(a).Name
Next
Rg.Resize(, Nb + 1).Font.Bold = True
Rg.Resize(, Nb + 1).BackColor = 12
Rg.Offset(1).CopyFromRecordset rs
Rg.CurrentRegion.EntireColumn.AutoFit
Rg.CurrentRegion.WrapText = True
Rg.CurrentRegion.BorderAround bordure,
xlHairline, 0
Rg.CurrentRegion.Borders.LineStyle xlContinuous
Rg.CurrentRegion.HorizontalAlignment xlHAlignCenter
Rg.CurrentRegion.VerticalAlignment xlVAlignCenter

Else
MsgBox "Aucun enregistrement trouvé."
End If

With Sh
Sh.PageSetup.CenterHorizontally = True
Sh.PageSetup.PrintTitleRows = ActiveSheet.Rows
("1:3").Address
Sh.PageSetup.PrintArea = Sh.Range
("A6").CurrentRegion.Address
End With


.DisplayAlerts = False
.ActiveWorkbook.SaveAs fichier & "RI
Facturable.xls"
.ActiveWorkbook.Close
.DisplayAlerts = True
.Quit

End With

db.Close
XL_App.Quit
Set XL_App = Nothing
Set XL_classeur = Nothing
Set XL_feuille = Nothing

End Sub


Merci de votre aide

Keawee