***EXPORTER VERS EXCEL ***

Question

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

jrivet · Answer

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  ;) 
-----------------------------------------------------------

cs_CanisLupus · Answer

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

cs_CanisLupus · Answer

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

EXPORTER VERS EXCEL

3 réponses

Discussions similaires