Macro Access qui ouvre un doc Excel

M

Mosbacher

Guest
Bonjour,

je me connecte à l'aide d'Access à une base de donnée Gescom (SAGE)
puis je veux afficher les résultats dans un classeur excel et lui appliquer des styles...

Le problème est que j'arrive bien à faire ma requête, ouvrir Excel, afficher le résultat mais je n'arrive plus à faire les choses suivantes :
- aller à la fin de la liste
- sélectionner tous les cellules utilisées et aplliquer des bordures...


Voilà mon code.
Je serais très heureux que quelqu'un puisse m'aider

***************************************
' SheetType
'xlChart = -4109;
'xlWorksheet = -4167;
' WBATemplate
'xlWBATWorksheet = -4167;
'xlWBATChart = -4109;
' Page Setup
'xlPortrait = 1;
'xlLandscape = 2;
'xlPaperA4 = 9;
' Format Cells
'xlBottom = -4107;
'xlLeft = -4131;
'xlRight = -4152;
'xlTop = -4160;
' Text Alignment
'xlHAlignCenter = -4108;
'xlVAlignCenter = -4108;
' Cell Borders
'xlThick = 4;
'xlThin = 2;

Public Sub LoadExcel()

SourceGesCom = "DNS_EXPORT_EXCEL" 'Ta source de données
LoginGesCom = "FB"
PassGesCom = "" 'Vide s'il n'y a pas de mot de passe sinon respecter la casse


Connection_GesCom = "DSN=" & SourceGesCom & ";UID=" & LoginGesCom & ";PWD=" & PassGesCom
Set GesCom = New ADODB.Connection 'Création de la connection
GesCom.ConnectionTimeout = 15 'Définition du TimeOut de connexion
GesCom.CommandTimeout = 30 'Définition du TimeOut d'exécution de requêtes
GesCom.Open Connection_GesCom



Set rs = CreateObject("ADODB.recordset")

sql = "SELECT AR_Ref,AR_Design,AR_PrixVen FROM F_ARTICLE"
sql = sql & " WHERE AR_PrixVen > 0 AND AR_PrixVen < 5"
rs.Open sql, GesCom


Set oExcel = CreateObject("Excel.Application")

DoEvents
Screen.MousePointer = vbDefault


With oExcel
.Workbooks.Add
.ActiveSheet.Name = "LISTE ARTICLES"
.Visible = True
End With




With oExcel.Worksheets("LISTE ARTICLES")
.Columns("A").ColumnWidth = 30 '"REF"
.Columns("A").HorizontalAlignment = -4131
'.Columns("A").NumberFormat = "###0"
.Columns("B").ColumnWidth = 80 '"DESIGNATION"
.Columns("B").HorizontalAlignment = -4131
.Columns("C").ColumnWidth = 20 '"PX VENTE HT"
.Columns("C").HorizontalAlignment = -4152
.Columns("C").NumberFormat = "#,##0.00"

rc = 1

.Range("A1:C1").Font.Bold = True
.Range("A1").Value = "REF"
.Range("B1").Value = "DESIGNATION"
.Range("C1").Value = "PX VENTE HT"

rc = rc + 1 'SKIP 2 LINES


Do While Not rs.EOF
For j = 0 To rs.Fields.Count - 1
If Not IsNull(rs.Fields(j).Value) Then
.Cells(rc, j + 1).Font.Size = "8"
.Cells(rc, j + 1).Font.Name = "Verdana"
.Cells(rc, j + 1).Value = rs.Fields(j).Value
Else
.Cells("& rc &", "& j+1 &").Value = """"
End If
Next
rc = rc + 1
rs.MoveNext
Loop

'Set rngCurrent = oExcel.Worksheets("LISTE ARTICLES").UsedRange
'oExcel.Worksheets("LISTE ARTICLES").UsedRange.AutoFormat xlRangeAutoFormatAccounting4

End With

Presentation

oExcel.activeworkbook.saveas "c:\ODBC.xls"

If Not oExcel Is Nothing Then

If Not xlRunning Then
oExcel.DisplayAlerts = False
oExcel.Quit
End If

Set oExcel = Nothing
End If

End Sub

Sub Presentation()
'
' Macro1 Macro
' Macro enregistrée le 14/09/2004 par Fujitsu-siemens
'

'
oExcel.Worksheets("LISTE ARTICLES").Range("A2").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
oExcel.Worksheets("LISTE ARTICLES").Range("A1").Select
End Sub


****************************
 

Discussions similaires

Réponses
8
Affichages
640
Réponses
5
Affichages
1 K

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 812
dernier inscrit
abdouami