Vb .net sql et excel

helonear Messages postés 13 Date d'inscription vendredi 23 avril 2004 Statut Membre Dernière intervention 8 juin 2004 - 23 avril 2004 à 11:58
cs_labout Messages postés 1356 Date d'inscription samedi 8 décembre 2001 Statut Membre Dernière intervention 23 octobre 2006 - 23 avril 2004 à 18:12
salut

je suis actuellement en plein developpement d'une application de gestion d'horaire

et dans cette application on me demande d'exporter ma base de donnée sql dans un fichier Excel

ne sachant pas comment faire je me tourne vers vous pour vous demander conseil

d avance merci

13 réponses

cs_labout Messages postés 1356 Date d'inscription samedi 8 décembre 2001 Statut Membre Dernière intervention 23 octobre 2006 8
23 avril 2004 à 12:10
labout

Il s'agit d'une table ou de toutes les tables ou du résultat d'une requete.

Dans le cas de requete je pourrai te donner le code (Long 600 lignes)
@+
0
crenaud76 Messages postés 4172 Date d'inscription mercredi 30 juillet 2003 Statut Membre Dernière intervention 9 juin 2006 28
23 avril 2004 à 13:15
Le plus simple est sans doute de faire un lot DTS

Christophe R.
0
cs_labout Messages postés 1356 Date d'inscription samedi 8 décembre 2001 Statut Membre Dernière intervention 23 octobre 2006 8
23 avril 2004 à 14:00
labout

Je te mets le code

Ce dode permet de tranférer vers Excel le contenu d'une requête avec encadrement et totaux éventuels.
Je me suis trompé (238 lignes)

Option Strict On
Option Explicit On
Module DocExcel
' nom du fichier xls total oui ou non
Function EtatExcel(ByRef rs As ADODB.Recordset, ByRef etat As String, ByRef bBol As Boolean) As Boolean
Dim fichier As String
Dim FrmSt As New FrmStatus
Dim i As Integer
Dim j As Integer
Dim nb As Integer
Dim sCols As String
Dim iFields As Integer
Dim ExcelWasNotRunning As Boolean
Dim iLastcol As Integer

Dim excelApp As New Excel.Application
Dim excelBook As Excel.Workbook = excelApp.Workbooks.Add
Dim excelWorksheet As Excel.Worksheet = _
CType(excelBook.Worksheets(1), Excel.Worksheet)
Dim rng As Excel.Range

' Unlike the Word demo, we'll make the spreadsheet visible so you can see
' the data being entered.
excelApp.Visible = True
On Error GoTo err_Renamed
FrmSt.Show("Création de la feuille Excel en cours." & vbCrLf & "Patientez...")
iFields = rs.Fields.Count - 1
fichier = New String(Chr(0), 100)
'Get the temporary path
GetTempPath(100, fichier)
fichier = CLeft(fichier, InStr(fichier, Chr(0)) - 1)

fichier = Trim(fichier) & etat & ".XLS"
If Dir(fichier) <> "" Then
Kill(fichier)
End If

With excelApp.Application
.Workbooks.Add()
.ActiveWorkbook.SaveAs(fichier)
For i = 0 To iFields
.Cells(1, i + 1) = rs.Fields(i).Name
Next
j = 2
nb = 0
Do While Not rs.EOF
System.Windows.Forms.Application.DoEvents()
nb = nb + 1
For i = 0 To iFields
System.Windows.Forms.Application.DoEvents()
.Cells(j, i + 1) = rs.Fields(i).Value
Next
j = j + 1
rs.MoveNext()
Loop

' on autorise 104 colonnes pour le moment
For i = 1 To iFields + 1
If i <= 26 Then
sCols = Chr(64 + i) & ":" & Chr(64 + i)
Else ' 64+27-26
If i <= 52 Then
sCols = "A" & Chr(64 + i - 26) & ":" & "A" & Chr(64 + i - 26)
Else
If i <= 78 Then
sCols = "A" & Chr(64 + i - 26) & ":" & "B" & Chr(64 + i - 52)
Else
sCols = "A" & Chr(64 + i - 26) & ":" & "C" & Chr(64 + i - 78)
End If
End If
End If
rng = .Range(sCols)
rng.EntireColumn.AutoFit()
Next
If iFields + 1 <= 26 Then
sCols = Chr(65) & "1:" & Chr(64 + iFields + 1) & "1" ' A1: E1
Else
If iFields + 1 <= 52 Then
sCols = Chr(65) & "1:" & "A" & Chr(64 + iFields + 1 - 26) & "1"
Else
If iFields + 1 <= 78 Then
sCols = Chr(65) & "1:" & "B" & Chr(64 + iFields + 1 - 52) & "1"
Else
sCols = Chr(65) & "1:" & "C" & Chr(64 + iFields + 1 - 78) & "1"
End If
End If
End If

.Range(sCols).Select()
rng = .Range(sCols)
With rng.Borders(Excel.XlBordersIndex.xlEdgeLeft)
.LineStyle = 1 'xlContinuous
.Weight = -4138 ' xlMedium
.ColorIndex = -4105 ' xlAutomatic
End With
With rng.Borders(Excel.XlBordersIndex.xlEdgeTop)
.LineStyle = 1 'xlContinuous
.Weight = -4138 ' xlMedium
.ColorIndex = -4105 ' xlAutomatic
End With

With rng.Borders(Excel.XlBordersIndex.xlEdgeRight)
.LineStyle = 1 ' xlContinuous
.Weight = -4138 ' xlMedium
.ColorIndex = -4105 ' xlAutomatic
End With

With rng.Borders(Excel.XlBordersIndex.xlEdgeBottom)
.LineStyle = 1 ' xlContinuous
.Weight = -4138 ' xlMedium
.ColorIndex = -4105 ' xlAutomatic
End With
With rng.Borders(Excel.XlBordersIndex.xlInsideVertical)
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
If iFields + 1 <= 26 Then
sCols = Chr(65) & "1:" & Chr(64 + iFields + 1) & nb + 1
Else
If iFields + 1 <= 52 Then
sCols = Chr(65) & "1:" & "A" & Chr(64 + iFields + 1 - 26) & nb + 1
Else
If iFields + 1 <= 78 Then
sCols = Chr(65) & "1:" & "B" & Chr(64 + iFields + 1 - 52) & nb + 1
Else
sCols = Chr(65) & "1:" & "C" & Chr(64 + iFields + 1 - 78) & nb + 1
End If
End If
End If
.Range(sCols).Select()
rng = .Range(sCols)
With rng.Borders(Excel.XlBordersIndex.xlEdgeLeft) ' left
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With rng.Borders(Excel.XlBordersIndex.xlEdgeTop) ' top
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With rng.Borders(Excel.XlBordersIndex.xlEdgeBottom) ' bottom
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With rng.Borders(Excel.XlBordersIndex.xlEdgeRight) ' right
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With rng.Borders(Excel.XlBordersIndex.xlInsideVertical) ' verticale
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
' total si bBol
If bBol Then
.Cells(nb + 2, 1) = "Total"
'
Select Case etat
Case "statistiques dr-drf"
sCols = Chr(65 + rs.Fields.Count - 1) & "2" & ":" & Chr(65 + rs.Fields.Count - 1) & nb + 1
.Cells(nb + 2, rs.Fields.Count) = "=Somme(" & sCols & ")"
sCols = Chr(65) & nb + 2 & ":" & Chr(65 + rs.Fields.Count - 1) & nb + 2
Case "coutdurisque"
sCols = Chr(65 + rs.Fields.Count - 3) & 2 & ":" & Chr(65 + rs.Fields.Count - 3) & nb + 1 ' &
.Cells(nb + 2, rs.Fields.Count - 2) = "=Somme(" & sCols & ")"
sCols = Chr(65 + rs.Fields.Count - 2) & 2 & ":" & Chr(65 + rs.Fields.Count - 2) & nb + 1
.Cells(nb + 2, rs.Fields.Count - 1) = "=Somme(" & sCols & ")"
Case "prodmensuelle"
sCols = Chr(65 + rs.Fields.Count - 3) & 2 & ":" & Chr(65 + rs.Fields.Count - 3) & nb + 1
.Cells(nb + 2, rs.Fields.Count - 2) = "=Somme(" & sCols & ")"
sCols = Chr(65 + rs.Fields.Count - 4) & 2 & ":" & Chr(65 + rs.Fields.Count - 4) & nb + 1
.Cells(nb + 2, rs.Fields.Count - 3) = "=Somme(" & sCols & ")"
End Select
If iFields <= 26 Then
sCols = Chr(65) & nb + 2 & ":" & Chr(65 + iFields) & nb + 2
Else
If iFields <= 52 Then
sCols = Chr(65) & nb + 2 & ":" & "A" & Chr(65 + iFields - 26) & nb + 2
Else
If iFields <= 78 Then
sCols = Chr(65) & nb + 2 & ":" & "B" & Chr(65 + iFields - 52) & nb + 2
Else
sCols = Chr(65) & nb + 2 & ":" & "C" & Chr(65 + iFields - 78) & nb + 2
End If
End If
End If

.Range(sCols).Select()
rng = .Range(sCols)
With rng.Borders(Excel.XlBordersIndex.xlEdgeTop) ' top
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With rng.Borders(Excel.XlBordersIndex.xlEdgeBottom) ' bottom
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With rng.Borders(Excel.XlBordersIndex.xlEdgeRight) ' right
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With rng.Borders(Excel.XlBordersIndex.xlInsideVertical) ' verticale
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
End If
.Application.ActiveWorkbook.Save()
End With

FrmSt.Close()
FrmSt.Dispose()
excelApp.Visible = True

MsgBox("Pressez une touche et Excel va se fermer Excel" & vbCrLf & "Votre fichier s'appelle " & fichier, MsgBoxStyle.Information)
excelApp.Application.Quit()
Exit Function
err_Renamed:
TraceError("Module DocExcel Fonction EtatExcel", Err.Description, Err.Number, Err.Source)

MsgBox("Erreur: " & Err.Description, MsgBoxStyle.Critical)
Err.Clear()
excelApp.Application.Quit()
excelApp = Nothing
FrmSt.Close()
FrmSt.Dispose()
Exit Function
End Function
End Module

Cela vaudra mieux qu'un yaka
0
cs_labout Messages postés 1356 Date d'inscription samedi 8 décembre 2001 Statut Membre Dernière intervention 23 octobre 2006 8
23 avril 2004 à 14:01
labout

Je te mets le code

Ce dode permet de tranférer vers Excel le contenu d'une requête avec encadrement et totaux éventuels.
Je me suis trompé (238 lignes)

Option Strict On
Option Explicit On
Module DocExcel
' nom du fichier xls total oui ou non
Function EtatExcel(ByRef rs As ADODB.Recordset, ByRef etat As String, ByRef bBol As Boolean) As Boolean
Dim fichier As String
Dim FrmSt As New FrmStatus
Dim i As Integer
Dim j As Integer
Dim nb As Integer
Dim sCols As String
Dim iFields As Integer
Dim ExcelWasNotRunning As Boolean
Dim iLastcol As Integer

Dim excelApp As New Excel.Application
Dim excelBook As Excel.Workbook = excelApp.Workbooks.Add
Dim excelWorksheet As Excel.Worksheet = _
CType(excelBook.Worksheets(1), Excel.Worksheet)
Dim rng As Excel.Range

' Unlike the Word demo, we'll make the spreadsheet visible so you can see
' the data being entered.
excelApp.Visible = True
On Error GoTo err_Renamed
FrmSt.Show("Création de la feuille Excel en cours." & vbCrLf & "Patientez...")
iFields = rs.Fields.Count - 1
fichier = New String(Chr(0), 100)
'Get the temporary path
GetTempPath(100, fichier)
fichier = CLeft(fichier, InStr(fichier, Chr(0)) - 1)

fichier = Trim(fichier) & etat & ".XLS"
If Dir(fichier) <> "" Then
Kill(fichier)
End If

With excelApp.Application
.Workbooks.Add()
.ActiveWorkbook.SaveAs(fichier)
For i = 0 To iFields
.Cells(1, i + 1) = rs.Fields(i).Name
Next
j = 2
nb = 0
Do While Not rs.EOF
System.Windows.Forms.Application.DoEvents()
nb = nb + 1
For i = 0 To iFields
System.Windows.Forms.Application.DoEvents()
.Cells(j, i + 1) = rs.Fields(i).Value
Next
j = j + 1
rs.MoveNext()
Loop

' on autorise 104 colonnes pour le moment
For i = 1 To iFields + 1
If i <= 26 Then
sCols = Chr(64 + i) & ":" & Chr(64 + i)
Else ' 64+27-26
If i <= 52 Then
sCols = "A" & Chr(64 + i - 26) & ":" & "A" & Chr(64 + i - 26)
Else
If i <= 78 Then
sCols = "A" & Chr(64 + i - 26) & ":" & "B" & Chr(64 + i - 52)
Else
sCols = "A" & Chr(64 + i - 26) & ":" & "C" & Chr(64 + i - 78)
End If
End If
End If
rng = .Range(sCols)
rng.EntireColumn.AutoFit()
Next
If iFields + 1 <= 26 Then
sCols = Chr(65) & "1:" & Chr(64 + iFields + 1) & "1" ' A1: E1
Else
If iFields + 1 <= 52 Then
sCols = Chr(65) & "1:" & "A" & Chr(64 + iFields + 1 - 26) & "1"
Else
If iFields + 1 <= 78 Then
sCols = Chr(65) & "1:" & "B" & Chr(64 + iFields + 1 - 52) & "1"
Else
sCols = Chr(65) & "1:" & "C" & Chr(64 + iFields + 1 - 78) & "1"
End If
End If
End If

.Range(sCols).Select()
rng = .Range(sCols)
With rng.Borders(Excel.XlBordersIndex.xlEdgeLeft)
.LineStyle = 1 'xlContinuous
.Weight = -4138 ' xlMedium
.ColorIndex = -4105 ' xlAutomatic
End With
With rng.Borders(Excel.XlBordersIndex.xlEdgeTop)
.LineStyle = 1 'xlContinuous
.Weight = -4138 ' xlMedium
.ColorIndex = -4105 ' xlAutomatic
End With

With rng.Borders(Excel.XlBordersIndex.xlEdgeRight)
.LineStyle = 1 ' xlContinuous
.Weight = -4138 ' xlMedium
.ColorIndex = -4105 ' xlAutomatic
End With

With rng.Borders(Excel.XlBordersIndex.xlEdgeBottom)
.LineStyle = 1 ' xlContinuous
.Weight = -4138 ' xlMedium
.ColorIndex = -4105 ' xlAutomatic
End With
With rng.Borders(Excel.XlBordersIndex.xlInsideVertical)
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
If iFields + 1 <= 26 Then
sCols = Chr(65) & "1:" & Chr(64 + iFields + 1) & nb + 1
Else
If iFields + 1 <= 52 Then
sCols = Chr(65) & "1:" & "A" & Chr(64 + iFields + 1 - 26) & nb + 1
Else
If iFields + 1 <= 78 Then
sCols = Chr(65) & "1:" & "B" & Chr(64 + iFields + 1 - 52) & nb + 1
Else
sCols = Chr(65) & "1:" & "C" & Chr(64 + iFields + 1 - 78) & nb + 1
End If
End If
End If
.Range(sCols).Select()
rng = .Range(sCols)
With rng.Borders(Excel.XlBordersIndex.xlEdgeLeft) ' left
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With rng.Borders(Excel.XlBordersIndex.xlEdgeTop) ' top
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With rng.Borders(Excel.XlBordersIndex.xlEdgeBottom) ' bottom
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With rng.Borders(Excel.XlBordersIndex.xlEdgeRight) ' right
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With rng.Borders(Excel.XlBordersIndex.xlInsideVertical) ' verticale
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
' total si bBol
If bBol Then
.Cells(nb + 2, 1) = "Total"
'
Select Case etat
Case "statistiques dr-drf"
sCols = Chr(65 + rs.Fields.Count - 1) & "2" & ":" & Chr(65 + rs.Fields.Count - 1) & nb + 1
.Cells(nb + 2, rs.Fields.Count) = "=Somme(" & sCols & ")"
sCols = Chr(65) & nb + 2 & ":" & Chr(65 + rs.Fields.Count - 1) & nb + 2
Case "coutdurisque"
sCols = Chr(65 + rs.Fields.Count - 3) & 2 & ":" & Chr(65 + rs.Fields.Count - 3) & nb + 1 ' &
.Cells(nb + 2, rs.Fields.Count - 2) = "=Somme(" & sCols & ")"
sCols = Chr(65 + rs.Fields.Count - 2) & 2 & ":" & Chr(65 + rs.Fields.Count - 2) & nb + 1
.Cells(nb + 2, rs.Fields.Count - 1) = "=Somme(" & sCols & ")"
Case "prodmensuelle"
sCols = Chr(65 + rs.Fields.Count - 3) & 2 & ":" & Chr(65 + rs.Fields.Count - 3) & nb + 1
.Cells(nb + 2, rs.Fields.Count - 2) = "=Somme(" & sCols & ")"
sCols = Chr(65 + rs.Fields.Count - 4) & 2 & ":" & Chr(65 + rs.Fields.Count - 4) & nb + 1
.Cells(nb + 2, rs.Fields.Count - 3) = "=Somme(" & sCols & ")"
End Select
If iFields <= 26 Then
sCols = Chr(65) & nb + 2 & ":" & Chr(65 + iFields) & nb + 2
Else
If iFields <= 52 Then
sCols = Chr(65) & nb + 2 & ":" & "A" & Chr(65 + iFields - 26) & nb + 2
Else
If iFields <= 78 Then
sCols = Chr(65) & nb + 2 & ":" & "B" & Chr(65 + iFields - 52) & nb + 2
Else
sCols = Chr(65) & nb + 2 & ":" & "C" & Chr(65 + iFields - 78) & nb + 2
End If
End If
End If

.Range(sCols).Select()
rng = .Range(sCols)
With rng.Borders(Excel.XlBordersIndex.xlEdgeTop) ' top
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With rng.Borders(Excel.XlBordersIndex.xlEdgeBottom) ' bottom
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With rng.Borders(Excel.XlBordersIndex.xlEdgeRight) ' right
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
With rng.Borders(Excel.XlBordersIndex.xlInsideVertical) ' verticale
.LineStyle = 1
.Weight = -4138
.ColorIndex = -4105
End With
End If
.Application.ActiveWorkbook.Save()
End With

FrmSt.Close()
FrmSt.Dispose()
excelApp.Visible = True

MsgBox("Pressez une touche et Excel va se fermer Excel" & vbCrLf & "Votre fichier s'appelle " & fichier, MsgBoxStyle.Information)
excelApp.Application.Quit()
Exit Function
err_Renamed:
MsgBox("Erreur: " & Err.Description, MsgBoxStyle.Critical)
Err.Clear()
excelApp.Application.Quit()
excelApp = Nothing
FrmSt.Close()
FrmSt.Dispose()
Exit Function
End Function
End Module

C'esu un code PERSO VB6 que j'ai adapté en VB.NET
Cela vaudra mieux qu'un yaka
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
helonear Messages postés 13 Date d'inscription vendredi 23 avril 2004 Statut Membre Dernière intervention 8 juin 2004
23 avril 2004 à 15:10
merci beaucoup pour vos contribution encore qu il faudrait peu etre m expliquer ce qu est le DTS

et merci grace a toi je vai encore utiliser 3 tubes d aspirines pour relire et comprendre ton code

en tout cas merci
0
crenaud76 Messages postés 4172 Date d'inscription mercredi 30 juillet 2003 Statut Membre Dernière intervention 9 juin 2006 28
23 avril 2004 à 15:16
DTS veut dire Data Transformation Service ! Sur un SQLServer, tu as un service MSDTS qui permet d'importer/exporter des données depuis a peu près n'importe quoi (base sql, ficheir texte, excel, base access, oracle, ou odbc) vers ou depuis à peu près n'importe quoi ! C'est ultra-puissant, automatisable, et simple a programmer : il suffit de poser des "briques" fonctionnelles, un peu comme si tu dessinais ton algorithme de transfert, et ca roule.
Voir la doc de SQLServer sur le sujet, ou il y a un tres bon tutor (sur celle de la version 2000 toujours)

Christophe R.
0
helonear Messages postés 13 Date d'inscription vendredi 23 avril 2004 Statut Membre Dernière intervention 8 juin 2004
23 avril 2004 à 15:22
hum tres interessant encore merci pour ce cours de base de donnée dont j avais besoin merci
0
cs_labout Messages postés 1356 Date d'inscription samedi 8 décembre 2001 Statut Membre Dernière intervention 23 octobre 2006 8
23 avril 2004 à 15:51
labout
Avec ce que je t'ai donné tu n'as rien à modifier
Il suffit de le mettre dans un module
et il te fuffit d'appeller la fonction avec les 3 parametres
cela te fait même les cadres.
Tu n'as même pas besoin de comprendre comment cela marche
@+
0
crenaud76 Messages postés 4172 Date d'inscription mercredi 30 juillet 2003 Statut Membre Dernière intervention 9 juin 2006 28
23 avril 2004 à 16:41
Meme s'il n'a pas besoin de comprendre comment cela marche, j'espère pour lui qu'il essaiera de comprendre .... sinon je lui cause plus

Christophe R.
0
cs_labout Messages postés 1356 Date d'inscription samedi 8 décembre 2001 Statut Membre Dernière intervention 23 octobre 2006 8
23 avril 2004 à 17:01
labout
Ce n'est pas bien complexe c'est simplement long pour le tracé des cadres
Sans cadres cela prends 20 lignes en gros
On ne sait pas ce que fait le DTS et pourtant on l'utilise.
De même avec les DLL dont on n'a pas les sources à moins que tu les décompiles !!!
J'aurai aussi bien pu lui forunir sous forme de DLL sans le code.
0
crenaud76 Messages postés 4172 Date d'inscription mercredi 30 juillet 2003 Statut Membre Dernière intervention 9 juin 2006 28
23 avril 2004 à 17:07
Qd ta pas el code, d'accord, tu utilises et tu te tais, mais qd tu l'as, si tu le comprend pas c'est dommage.
Maintenant, chacun sa vision des choses

Christophe R.
0
helonear Messages postés 13 Date d'inscription vendredi 23 avril 2004 Statut Membre Dernière intervention 8 juin 2004
23 avril 2004 à 17:32
he bien etant etudiant mon but est quand meme d essayer de comprendre

merci a vous 2
0
cs_labout Messages postés 1356 Date d'inscription samedi 8 décembre 2001 Statut Membre Dernière intervention 23 octobre 2006 8
23 avril 2004 à 18:12
labout
Alors ne te plains pas et épluche le prog.
0
Rejoignez-nous