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
****************************
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
****************************