VBA Excel Clic auto sur bouton Annuler
Bonjour à tous,
j'ai un petit souci pour la gestion des boites des dialogues.
en effet, j'ouvre un tas de fichiers proteges en lecture et d'autres en ecriture, je voudrai ne aps avoir à l'ecran la boite de dialogue qui demande d'entrer le mot de passe (je voudrais un clic auto sur le bouton annuler à chaque fois pour pouvoir faire mon traitement sur els fichiers).
Merci pour votre aide !
ps: je suis sur EXCEL 2007
Il faut nous montrer un exemple.
Ok
appXls.DisplayAlerts = False
Set wbk = Workbooks.Open(chemin) ' ouverture du fichier
wbk.appXls.DisplayAlerts = True
If Err.Number > 0 Then ' il y a une protection soit en lecture soit en ecriture donc boite de dialogue pr entrer le MDP
wbk.Close False
Set wbk = Nothing
wbk.appXls.DisplayAlerts = False
Set wbk = Workbooks.Open(chemin, False, True, , "", , True)
appXls.DisplayAlerts = True
If Err.Number = 1004 Then ' rajout
rsltFileProtect = "Lecture"
Else
rsltFileProtect = "Ecriture"
Si c'est une boite de dialogue qui propose LEcture seule je voudrais cliquer sur "annuler"
sinon je voudrais cliquer sur le bouton par defaut qui est mis en valeur en bleu....
Idem pour la boite de dialogue qui apparait lorsque j'enregistre un fichier partagé pour l edepartager...je voudrais cliquer sur le bouton "oui" de la boite de dialogue mais en vain ! ça me bloque depuis 4 jours
voici le code de la macro. pour les fichiers partagés, je mettrai un fond de couleur:
Public Sub Get_Excel_Info(chemin As String)
On Error Resume Next
rsltFileProtect = ""
rsltVBProject = ""
rsltVBProtect = ""
rsltNbSheet = 0
rsltNbPvtTab = 0
rsltNbGraph = 0
rsltClasseurPartage = ""
rsltNbModules = 0
rsltProjVBALines = 0
rsltCodeVBALines = 0
'wbk.appXls.EnableEvents = True
appXls.Visible = False
' Set wbk = Workbooks.Open(chemin, False, True, , "", , True)
Dim wks As Worksheet
Dim pt As PivotTable
Dim VBProjSaveAs As VBIDE.VBProject
Dim VBProj As VBIDE.VBProject
Dim datestrg As String
Dim cheminSave As String
Dim strSaveAs As String
Dim wbkSaveAs As Workbook, wbk As Workbook
' Set VBProj = wbk.VBProject
Dim myFso, fDelete, myFolder
appXls.DisplayAlerts = False
Set wbk = Workbooks.Open(chemin) ' rajout
wbk.appXls.DisplayAlerts = True
If Err.Number > 0 Then 'il y a une protection
wbk.Close False
Set wbk = Nothing
wbk.appXls.DisplayAlerts = False
Set wbk = Workbooks.Open(chemin, False, True, , "", , True)
appXls.DisplayAlerts = True
If Err.Number = 1004 Then ' rajout
rsltFileProtect = "Lecture"
Else
rsltFileProtect = "Ecriture"
rsltNbSheet = wbk.Worksheets.Count 'nb TCD et Graphiques
For Each wks In Worksheets
For Each pt In wks.PivotTables
rsltNbPvtTab = rsltNbPvtTab + 1
Next pt
rsltNbGraph = rsltNbGraph + wks.ChartObjects.Count
Next wks
'classeur partagé?
If wbk.MultiUserEditing Then 'protege et partage
rsltClasseurPartage = "Partagé" 'il faut departager pr acceder aux auters proprietes vbaProject
datestrg = Replace(Replace(Replace(Now(), "/", ""), ":", ""), " ", "")
cheminSave = wbk.Path
strSaveAs = cheminSave & "\test scan a jeter" & datestrg
'MsgBox strSaveAs
appXls.ScreenUpdating = False
appXls.DisplayAlerts = False
'
ActiveWorkbook.SaveAs FileName:=strSaveAs
Set wbkSaveAs = ActiveWorkbook
wbkSaveAs.Activate
' SuprimePartage
wbkSaveAs.UnprotectSharing
wbkSaveAs.ExclusiveAccess
appXls.ScreenUpdating = True
appXls.DisplayAlerts = True
'VBA Project
rsltVBProject = wbkSaveAs.HasVBProject
If rsltVBProject = True Then
Set VBProjSaveAs = wbkSaveAs.VBProject
If VBProjSaveAs.Protection = vbext_pp_locked Then
rsltVBProtect = "Protégé partage"
Else
rsltProjVBALines = TotalLinesInProject(VBProjSaveAs)
rsltCodeVBALines = TotalCodeLinesInProject(VBProjSaveAs)
rsltNbModules = VBProjSaveAs.VBComponents.Count
End If
Set VBProjSaveAs = Nothing
End If
wbkSaveAs.Close SaveChanges:=False
Set myFso = CreateObject("Scripting.FileSystemObject")
' Set myFolder = myFso.GetFolder(cheminSave)
Set fDelete = myFso.GetFile(strSaveAs)
fDelete.Delete
Kill (strSaveAs)
'MsgBox "fic test delete" & strSaveAs
Else 'protege et PAS partage
rsltVBProject = wbk.HasVBProject 'VBA Project
If rsltVBProject = True Then
Set VBProj = wbk.VBProject
If VBProj.Protection = vbext_pp_locked Then
rsltVBProtect = "Protégé, pas partage"
Else
rsltProjVBALines = TotalLinesInProject(VBProj)
rsltCodeVBALines = TotalCodeLinesInProject(VBProj)
rsltNbModules = VBProj.VBComponents.Count
End If
Set VBProj = Nothing
End If
wbk.Close SaveChanges:=False
End If
End If
Else ' fichiers normaux
rsltFileProtect = "Libre"
rsltNbSheet = wbk.Worksheets.Count 'nb feuilles
For Each wks In Worksheets
For Each pt In wks.PivotTables
rsltNbPvtTab = rsltNbPvtTab + 1
Next pt
rsltNbGraph = rsltNbGraph + wks.ChartObjects.Count 'nb TCD et Graphiques
Next wks
If wbk.MultiUserEditing Then 'normal partage
rsltClasseurPartage = "Partagé" 'il faut departager pr acceder aux auters proprietes vbaProject
datestrg = Replace(Replace(Replace(Now(), "/", ""), ":", ""), " ", "")
cheminSave = wbk.Path
strSaveAs = cheminSave & "\test scan a jeter" & datestrg
appXls.ScreenUpdating = False
appXls.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:=strSaveAs, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Set wbkSaveAs = ActiveWorkbook
wbkSaveAs.Activate
' SuprimePartage
wbkSaveAs.UnprotectSharing
wbkSaveAs.ExclusiveAccess
appXls.ScreenUpdating = True
appXls.DisplayAlerts = True
'VBA Project
rsltVBProject = wbkSaveAs.HasVBProject
If rsltVBProject = True Then
Set VBProjSaveAs = wbkSaveAs.VBProject
If VBProjSaveAs.Protection = vbext_pp_locked Then
rsltVBProtect = "N Partage"
Else
rsltProjVBALines = TotalLinesInProject(VBProjSaveAs)
rsltCodeVBALines = TotalCodeLinesInProject(VBProjSaveAs)
rsltNbModules = VBProjSaveAs.VBComponents.Count
End If
Set VBProjSaveAs = Nothing
End If
wbkSaveAs.Close SaveChanges:=False
Set myFso = CreateObject("Scripting.FileSystemObject")
' Set myFolder = myFso.GetFolder(cheminSave)
Set fDelete = myFso.GetFile(strSaveAs)
fDelete.Delete
Kill (strSaveAs)
' MsgBox "fic test delete" & strSaveAs
Else 'pas partage normal
rsltVBProject = wbk.HasVBProject 'VBA Project
If rsltVBProject = True Then
Set VBProj = wbk.VBProject
If VBProj.Protection = vbext_pp_locked Then
rsltVBProtect = "N Pas Partage"
Else
rsltProjVBALines = TotalLinesInProject(VBProj)
rsltCodeVBALines = TotalCodeLinesInProject(VBProj)
rsltNbModules = VBProj.VBComponents.Count
End If
Set VBProj = Nothing
End If
wbk.Close SaveChanges:=False
End If
End If
appXls.ScreenUpdating = True
appXls.DisplayAlerts = True
'wbk.appXls.EnableEvents = True
'wbk.appXls.Visible = True
Set pt = Nothing
Set wks = Nothing
Set wbk = Nothing
End Sub