VB ACCESS - Exportation d'une requête avec mot de passe
steaker59
Messages postés
47
Date d'inscription
Statut
Membre
Dernière intervention
-
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention -
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention -
Bonjour à tous,
J'exporte via un bouton d'un de mes formulaires une requête de ma base de données ACCESS.
J'aimerai que le fichier excel créé soit sécurisé par un mot de passe. Pourrais-je faire sa sous Access ?
Le code est correct vous le trouverez ci-dessous :
Private Sub Commande70_Click()
Dim a As String
b = Day(Date) & "_" & Month(Date) & "_" & Year(Date)
a = Application.CurrentProject.Path & "\export" & b & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "Resultat", a
Dim xls As Excel.Application
On Error GoTo errHnd
Set xls = CreateObject("Excel.Application")
xls.Workbooks.Open Application.CurrentProject.Path & "\export" & b & ".xls"
xls.Visible = True
Exit Sub
errHnd:
MsgBox "Erreur N° " & Err.Number & vbLf & Err.Description, , Err.Source
End Sub
Merci infiniment pour votre aide !!
J'exporte via un bouton d'un de mes formulaires une requête de ma base de données ACCESS.
J'aimerai que le fichier excel créé soit sécurisé par un mot de passe. Pourrais-je faire sa sous Access ?
Le code est correct vous le trouverez ci-dessous :
Private Sub Commande70_Click()
Dim a As String
b = Day(Date) & "_" & Month(Date) & "_" & Year(Date)
a = Application.CurrentProject.Path & "\export" & b & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "Resultat", a
Dim xls As Excel.Application
On Error GoTo errHnd
Set xls = CreateObject("Excel.Application")
xls.Workbooks.Open Application.CurrentProject.Path & "\export" & b & ".xls"
xls.Visible = True
Exit Sub
errHnd:
MsgBox "Erreur N° " & Err.Number & vbLf & Err.Description, , Err.Source
End Sub
Merci infiniment pour votre aide !!
2 réponses
-
Bonjour,
Protection feuille:
Private Sub Commande70_Click() Dim a As String Dim xls As Excel.Application b = Day(Date) & "_" & Month(Date) & "_" & Year(Date) a = Application.CurrentProject.Path & "\export" & b & ".xls" DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "Resultat", a On Error GoTo errHnd Set xls = CreateObject("Excel.Application") xls.Workbooks.Open Application.CurrentProject.Path & "\export" & b & ".xls" xls.Visible = True 'Protection feuille: adaptez le nom de la feuille et le mot de passe xls.Workbooks(b & ".xls").Worksheets("Donnees").Protect Password:="Toto", DrawingObjects:=True, Contents:=True, Scenarios:=True xls.Workbooks(b & ".xls").Worksheets("donnees").EnableSelection = xlNoSelection Exit Sub errHnd: MsgBox "Erreur N° " & Err.Number & vbLf & Err.Description, , Err.Source End Sub -
Bonjour,
J'ai teste avec ce code (et une base personnelle), ca marche:
Private Sub Commande0_Click() Dim a As String Dim xls As Object b = Day(Date) & "_" & Month(Date) & "_" & Year(Date) a = Application.CurrentProject.Path & "\export" & b & ".xls" DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "Resultat", a On Error GoTo errHnd Set xls = CreateObject("Excel.Application") xls.Workbooks.Open Application.CurrentProject.Path & "\export" & b & ".xls" xls.Visible = True 'Protection feuille: adaptez le nom de la feuille et le mot de passe xls.Workbooks(b & ".xls").worksheets("Resultat").Protect Password:="Toto", DrawingObjects:=True, Contents:=True, Scenarios:=True xls.Workbooks(b & ".xls").worksheets("Resultat").EnableSelection = xlNoSelection xls.Quit Set xls = Nothing Exit Sub errHnd: MsgBox "Erreur N° " & Err.Number & vbLf & Err.Description, , Err.Source End Sub
A+
