[ACCESS/VB] Mettre un cartouche
ciracus
-
ciracus -
ciracus -
Bonjour,
Je suis débutante dans le langage vb et je suis actuellement en stage. Dans ce cadre, je fais
une petite base de donnée Access et je dois à l'aide d'un bouton faire des extractions de
certaines données vers Excel. Le problème est que mon tuteur souhaite qu'en haut de la feuille
Excel créée, il soit mis un cartouche avec par exemple : le nom de la personne qui a créé le fichier,
la date de création... Comment puis je coder cela? J'ai vraiment besoin d'aide!!!!
Merci beaucoup d'avance!
PS: Je vous joints le début de mon code:
Private Sub Extraire_Click()
On Error GoTo Err_Extraire_Click
Dim sql As String
Dim req As DAO.Recordset
sql = "SELECT table.* FROM table Where table!number <> 0 "
If Not Me.chk_champ1 Then
sql = sql & "And table.champ1 like '*" & Me.cmb_champ1 & "*' "
End If
If Not Me.chk_champ2 Then
sql = sql & "And table.champ2 like '*" & Me.cmb_champ2 & "*' "
End If
If Not Me.chk_champ3 Then
sql = sql & "And table.champ3 like '*" & Me.cmb_champ3 & "*' "
End If
sql = sql & ";"
'on créé la requête "NomRequete"
CurrentDb.CreateQueryDef "NomRequete", sql
'on exporte la requete "NomRequete" vers le fichier Excel
DoCmd.OutputTo acOutputQuery, "NomRequete", acFormatXLS, , True
'on libère (=supprimer) la requete "NomRequete"
DoCmd.DeleteObject acQuery, "NomRequete"
Exit_Extraire_Click:
Exit Sub
Err_Extraire_Click:
MsgBox Err.Description
DoCmd.DeleteObject acQuery, "NomRequete"
Resume Exit_Extraire_Click
End Sub
Encore merci d'avance.
Je suis débutante dans le langage vb et je suis actuellement en stage. Dans ce cadre, je fais
une petite base de donnée Access et je dois à l'aide d'un bouton faire des extractions de
certaines données vers Excel. Le problème est que mon tuteur souhaite qu'en haut de la feuille
Excel créée, il soit mis un cartouche avec par exemple : le nom de la personne qui a créé le fichier,
la date de création... Comment puis je coder cela? J'ai vraiment besoin d'aide!!!!
Merci beaucoup d'avance!
PS: Je vous joints le début de mon code:
Private Sub Extraire_Click()
On Error GoTo Err_Extraire_Click
Dim sql As String
Dim req As DAO.Recordset
sql = "SELECT table.* FROM table Where table!number <> 0 "
If Not Me.chk_champ1 Then
sql = sql & "And table.champ1 like '*" & Me.cmb_champ1 & "*' "
End If
If Not Me.chk_champ2 Then
sql = sql & "And table.champ2 like '*" & Me.cmb_champ2 & "*' "
End If
If Not Me.chk_champ3 Then
sql = sql & "And table.champ3 like '*" & Me.cmb_champ3 & "*' "
End If
sql = sql & ";"
'on créé la requête "NomRequete"
CurrentDb.CreateQueryDef "NomRequete", sql
'on exporte la requete "NomRequete" vers le fichier Excel
DoCmd.OutputTo acOutputQuery, "NomRequete", acFormatXLS, , True
'on libère (=supprimer) la requete "NomRequete"
DoCmd.DeleteObject acQuery, "NomRequete"
Exit_Extraire_Click:
Exit Sub
Err_Extraire_Click:
MsgBox Err.Description
DoCmd.DeleteObject acQuery, "NomRequete"
Resume Exit_Extraire_Click
End Sub
Encore merci d'avance.
Configuration: Windows XP Internet Explorer 6.0 Access 2003
2 réponses
-
Pourquoi tu n'ajoute pas simplement un champ de texte ?
Par exemple quand une personne créer un fichier, elle insère son nom que tu met dans ta bdd et tu n'as plus qu'à le récupérer.
Et la date tu l'insère en auto dans ta base.-
En fait, j'ai déjà dans mon formulaire des champs avec le nom et la date en auto, mais ce que je ne sais pas faire, c'est récupérer ces données et les mettre dans les premières lignes de la feuille Excel que je créé...
Actuellement, la première ligne contient les en-tête de la requete, et je voudrais que tout soit décallé plus bas et mettre dans les premières lignes le cartouche avec les données récupérées.
Suis-je assez claire?
Merci beaucoup de m'aider! -
-
Merci!
En réalité, je ne sais pas très bien s'il s'agit d'un problème Excel, dans la mesure où mon code doit etre dans access pour que la cartouche se remplisse et se place automatiquement en haut du fichier Excel.
Je pense qu'il doit falloir mettre quelque chose dans mon Sub "Extraire"comme :
Me.Nom.Copy
Range("A1").Select
"Nom: " & ActiveSheet.Paste
Application.CutCopyMode = False
Mais je ne sais vraiment pas comment m'y prendre... -
-
Je crois que ça veut dire : "sélectionner la case A1"
Vu que dans ma case A1 actuellement j'ai "champ1", je pourrais faire:
'Sélectionner la case A1
'Couper le contenu
'coller en A3
'Mettre en A1 la valeur de la cmb de mon formulaire
Mais le problème est qu'il faut alors décaller le contenu de la case A3.....
Donc, le mieux serait d'insérer une ligne?
En mettant qq chose du genre :
' insérer une ligne entre la 0 et la 1 de la Feuille NomFeuille
NomObjetWorkBook.WorkSheet("NomFeuille").Rows("1:1").Select
Selection.Insert Shift:=xlDown
Problème : je ne connais pas le nom de la feuille que je créé...
Et je ne sais pas non plus comment mettre en A1 le contenu de ma combox "cmb_Nom" de mon formulaire...
:S
-
-
Et voici donc la solution, ça peut toujours servir...
Rappel: Il s'agit de créer un fichier excel avec les résultats d'une requete qui comporte en haut un cartouche avec le nom, la date...
Private Sub Extraire_Click()
On Error GoTo Err_Extraire_Click
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlBook As Excel.Workbook
Dim I As Long, J As Long
Dim t0 As Long, t1 As Long
Dim rec As Recordset
Dim sql As String
MsgBox ("début de la création")
sql = "SELECT table.* FROM table Where table!number <> 0 "
If Not Me.chk_champ1 Then
sql = sql & "And table.champ1 like '*" & Me.cmb_champ1 & "*' "
End If
If Not Me.chk_champ2 Then
sql = sql & "And table.champ2 like '*" & Me.cmb_champ2 & "*' "
End If
If Not Me.chk_champ3 Then
sql = sql & "And table.champ3 like '*" & Me.cmb_champ3 & "*' "
End If
sql = sql & ";"
'on créé la requête rec
Set rec = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
'on exporte la requete rec vers un nouveau fichier Excel
'Initialisations
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
'Ajouter une feuille de calcul
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = "Tutoriel2"
' le titre
xlSheet.Cells(1, 4) = "EXTRACTION DEPUIS LA BASE"
For J = 1 To 7
With xlSheet.Cells(1, J)
.Interior.ColorIndex = 8 (on met du bleu clair)
.Interior.Pattern = xlSolid
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
.HorizontalAlignment = xlCenter
End With
Next J
' écriture dans la cellule de ligne 2 et de colonne 1
xlSheet.Cells(2, 1) = "Nom :"
xlSheet.Cells(2, 2) = Me.txt_Nom.Value
' écriture dans la cellule de ligne 3 et de colonne 1
xlSheet.Cells(3, 1) = "Date :"
xlSheet.Cells(3, 2) = Date
' écriture dans la cellule de ligne 4 et de colonne 1
xlSheet.Cells(4, 1) = "Commentaire :"
xlSheet.Cells(4, 2) = Me.txt_commentaire.Value
' Nous appliquons des enrichissements de format aux cellules de titre
For I = 2 To 4
For J = 1 To 2
With xlSheet.Cells(I, J)
.Interior.ColorIndex = 6 (on met du jaune)
.Interior.Pattern = xlSolid
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
.HorizontalAlignment = xlCenter
End With
Next J
Next I
' les entetes
' .Fields(Index).Name renvoie le nom du champ
For J = 0 To rec.Fields.Count - 1
xlSheet.Cells(5, J + 1) = rec.Fields(J).Name
' Nous appliquons des enrichissements de format aux cellules d'en tete
With xlSheet.Cells(5, J + 1)
.Interior.ColorIndex = 15 (on met du gris)
.Interior.Pattern = xlSolid
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
.HorizontalAlignment = xlCenter
End With
Next J
' recopie des données à partir de la ligne 3
I = 6
Do While Not rec.EOF
For J = 0 To rec.Fields.Count - 1
' .Fields(Index).Type renvoie le type du champ
' si c'est un Texte (dbText) nous insérons "'" pour
' qu'il soit reconnu par Excel comme du Texte
If rec.Fields(J).Type = dbText Then
xlSheet.Cells(I, J + 1) = "'" & rec.Fields(J)
Else
xlSheet.Cells(I, J + 1) = rec.Fields(J)
End If
Next J
I = I + 1
rec.MoveNext
Loop
'enregistrement du fichier (on ouvre une boite windows "enregistrer sous" et il faut taper un nom du type .xls)
Do
fName = xlApp.GetSaveAsFilename
Loop Until fName <> False
xlBook.SaveAs Filename:=fName
MsgBox ("Le fichier a été créé avec succès!")
' code de fermeture
xlApp.Quit
rec.Close
'libération des objets
Set rec = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Exit_Extraire_Click:
Exit Sub
Err_Extraire_Click:
MsgBox Err.Description
DoCmd.DeleteObject acQuery, "NomRequete"
Resume Exit_Extraire_Click
End Sub
Et voilà! Merci beaucoup à MrSlave et à lermite222 (pour la fonction GetSaveAsFilename)
