***EXPORTER VERS EXCEL ***

cs_Heny
Messages postés
125
Date d'inscription
samedi 25 octobre 2003
Statut
Membre
Dernière intervention
19 avril 2007
- 18 oct. 2004 à 17:42
cs_CanisLupus
Messages postés
3757
Date d'inscription
mardi 23 septembre 2003
Statut
Membre
Dernière intervention
13 mars 2006
- 18 oct. 2004 à 20:33
Salut a tous
Dim Ms
Dim EX As New Excel.Application
Dim ligne As Long
Dim MSG, Msg1, Style, Title, Response, MyString
'Boite de dialogue demande de confirmation
MSG = "Vous allez exporter l'intégralité de la grille dans un fichier Excel." + Chr$(13) + Chr$(10)
MSG = MSG + "" + Chr$(13) + Chr$(10)
MSG = MSG + "Voulez vous vraiment continuer ?" + Chr$(13) + Chr$(10)
Style = vbYesNo + vbInformation + vbDefaultButton1 ' Définit les boutons.
Title = "Confirmation du transfert" ' Définit le titre.
Response = MsgBox(MSG, Style, Title)
If Response = vbYes Then ' L'utilisateur a choisi Oui.
MyString = "Oui" ' Effectue une action.

ligne = 1
If EX.Visible <> True Then
Ms = "Execl n'est pas installer sur votre machine ." + Chr$(13) + Chr$(10)
Ms = Ms + "Veuillez installer ce programme pour pouvoire utiliser cette option."
MsgBox Ms, vbInformation, "Information utilisateur"
Exit Sub
Else
EX.Workbooks.Add
With EX.ActiveWorkbook.Worksheets("Feuil1")

'inserer les titres
.Cells(ligne, 1) = "CATEGORIE"
.Cells(ligne, 2) = "REFERENCE"
.Cells(ligne, 3) = "DESIGNATION"
.Cells(ligne, 4) = "PX UNITAIRE"
.Cells(ligne, 5) = "QUANTITE"
.Cells(ligne, 6) = "PX TOTAL"
.Cells(ligne, 7) = "DATE"
.Cells(ligne, 8) = "PAYEMENT"
.Cells(ligne, 9) = "DT. PAYEMENT"
.Cells(ligne, 10) = "NUMERO"

End With
ligne = 3

With EX.ActiveWorkbook.Worksheets("Feuil1")
'Indique la largeur des colonnes
.Columns("A").ColumnWidth = 10
.Columns("B").ColumnWidth = 8
.Columns("C").ColumnWidth = 12
.Columns("D").ColumnWidth = 9
.Columns("E").ColumnWidth = 8
.Columns("F").ColumnWidth = 8
.Columns("G").ColumnWidth = 8
.Columns("H").ColumnWidth = 8
.Columns("I").ColumnWidth = 10
.Columns("J").ColumnWidth = 10

'Indique la police de caractères
.Cells.Font.Name = "Arial"

'Se positionne sur le premier enregistrement
Adodc1.Recordset.MoveFirst

'Indique la taille de caractères
.Cells.Font.Size = 8

Do Until Adodc1.Recordset.EOF
'Affiche les données dans les cellules d'Excel
.Cells(ligne, 1) = Adodc1.Recordset!Catégorie
.Cells(ligne, 2) = Adodc1.Recordset!Référence
.Cells(ligne, 3) = Adodc1.Recordset!Désignation
.Cells(ligne, 4) = Adodc1.Recordset![Prix de l'unité]
.Cells(ligne, 5) = Adodc1.Recordset!Quantité
.Cells(ligne, 6) = Adodc1.Recordset![Prix Total]
.Cells(ligne, 7) = DGP.Columns(6).Text
.Cells(ligne, 8) = Adodc1.Recordset!Payement
.Cells(ligne, 9) = DGP.Columns(8).Text
.Cells(ligne, 10) = Adodc1.Recordset!Numero

ligne = ligne + 1
'Passe à l'enregistrement suivant
Adodc1.Recordset.MoveNext
Loop

End With
End If
MyString = "Load"
End If

J'utilise ce code pour exporter le contenu d'une bd dans excel mais le probleme et que je ne pas trouver une solution pour avertir l'utilistateur par MSGBOX si dans ça machine il y a Excel ou pas pour faire l'exportation par ce que dans ce cas une erreur apparet
comment contourner ce probleme ??
et merci d'avance

3 réponses

jrivet
Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
60
18 oct. 2004 à 17:51
Salut,

Je suis pas sur de ce que je vais dire ;)

Windows n installe t il pas Excel toujours dans le meme endroit (sur un PC ou sur un autre).

Si c est le cas, tu as juste a regarder le chemin de l appli, et aller voir avec un dir si l application est presente ou pas .

C est un suggestion qui est un peu simplette je l accorde mais pourrait fonctionner si M bill Gates mets excel au meme endroit (et si l utilisateur l a pas changer de place entre temps.)
@+
Julien
-----------------------------------------------------------
:big) Essai ca sinon on trouvera autre chose ;)
-----------------------------------------------------------
0
cs_CanisLupus
Messages postés
3757
Date d'inscription
mardi 23 septembre 2003
Statut
Membre
Dernière intervention
13 mars 2006
18
18 oct. 2004 à 20:21
Salut,
Je t'avais donné une solution, qui rejoint ce que dit jrivet, lors de TON DERNIER MESSAGE :

Elle ne te convient pas ? Si non, on essaiera de trouver autre chose.

Cordialement, CanisLupus
0
cs_CanisLupus
Messages postés
3757
Date d'inscription
mardi 23 septembre 2003
Statut
Membre
Dernière intervention
13 mars 2006
18
18 oct. 2004 à 20:33
Une tite recherche et g trouvé CETTE PAGE , c'est basé sur l'interro de la base registre.
J'ai testé, ça marche.

Cordialement, CanisLupus
0