Problème as SaveAsUI

[Youri]

Bonjour à tous,

La petite macro suivante ne fonctionne absolument pas :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI = True Then SaveAsUI = False
End Sub

Est-ce que vous avez une idée ?

Merci à l'avance,
Youri

 

[Youri]

Re : Problème as SaveAsUI

Re:

Bon, j'ai fini par résoudre mon problème ... ou comment faire compliqué quand ça pourrait être simple :

Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.EnableEvents = False
Dim MonChoix As Variant
Cancel = True
If Not SaveAsUI Then
    ThisWorkbook.Save
    ThisWorkbook.Saved = True
    Else
    MonChoix = Application.GetSaveAsFilename(ThisWorkbook.Name, "Classeur Microsoft Office Excel (*.xls), *.xls")
End If
If Not MonChoix = False Then
    ThisWorkbook.SaveAs Filename:=MonChoix, FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    ThisWorkbook.Saved = True
End If
Application.EnableEvents = True
End Sub

Bonne soirée à tous,
Youri

 

[PascalXLD]

Re : Problème as SaveAsUI

Bonjour

IL aurait fallu expliquer ce que tu voulais faire avec ta macro

 

[Pierrot93]

Re : Problème as SaveAsUI

Bonjour Youri

je ne comprends pas trop ton problème, l'argument "SaveAsUI" détermine si la boite de dialogue "enregistrer sous" doit être affichée...

Que veux tu faire exactement ?

bonne soirée
@+

Aarf bonsoir Pascal, je n'avais pas raffraichis..

 

[Youri]

Re : Problème as SaveAsUI

Bonsoir Pascal, bonsoir Pierrot,

Merci pour votre implication.
En fait j'ai conçu une fiche qui change automatiquement à son ouverture de nombreux paramètres Excel.
Une fois cela fait, je me suis dit que l'utilisateur de la fiche serait quelque peu énervé si la fiche remettait à sa fermeture les paramètres par défaut d'Excel (imaginons qu'un utilisateur lambda ait passé x heures à paramétrer Excel et que tout d'un coup, une saleté de fiche lui efface tous ses réglages. Pas très agréable ...).
Je me suis alors mis à la réalisation d'un système de backup de tous les paramétrages changés. Voilà que c'est fait et que le backup est restauré à la fermeture de la fiche. Beaucoup mieux ... mais toujours pas suffisant car qu'est ce qui se passerait si le courant était coupé pendant que l'utilisateur travaille sur la fiche ou que, tout simplement, Excel plantait ... ?
Et bien dans ce cas, l'utilisateur va perdre à nouveau tous ses réglages. Puis comme

y'en a qui aime se faire des noeuds avec les boyeaux de la tête

je me suis dit que ce serait bien que la fiche propose après plantage de restaurer les données depuis le backup.
J'ai donc intégré jusqu'à trois backups dans la fiche et j'ai créé de jolis userforms pour pouvoir restaurer le backup voulu en cas de plantage.
Seulement là j'ai été confronté à un problème assez important : comment faire pour détecter que la fiche a été plantée. Je me suis dit la chose suivante :
à l'ouverture, on enregistre le mot "open" quelque part dans le backup et on enregistre la fiche avant que l'utilisateur ait le temps de faire quoique ce soit puis à la fermeture on inscrit "closed" et on enregistre.
Oui, mais si l'utilisateur décidait de ne pas enregistrer la fiche à la fermeture ...
Et à nouveau, tout mon raisonnement tombait à l'eau pour un problème simple.
Il m'a suffit alors pour résoudre cela de créer à chaque enregistrement du fichier un backup de la fiche dans un autre onglet avec la propriété xlSheetVeryHidden. Ce backup est restauré à la fin si on décide de ne pas enregistrer le fichier. Comme ça, tout semble marcher comme prévu.
Evidemment, pour mettre cela en place, j'ai eu besoin de prendre le contrôle sur tout le processus d'enregistrement, mais là, surprise je découvre que :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI = True Then SaveAsUI = False
End Sub

ne fonctionne pas pour annuler la boite de dialogue "Enregistrer sous ..." alors que pourtant c'est partout marqué sur internet que c'est censé le faire.
Bref, je n'ai toujours pas compris ce problème, mais je l'ai au moins résolu.
Je poste mon code d'ici quelque temps.

Bonne soirée à tous,
Youri

 

[Pierrot93]

Re : Problème as SaveAsUI

Bonjour Youri, Pascal

si j'ai bien compris, pas encore très sur...essaye comme ci dessous :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then Cancel = True
End Sub

a voir si c'est cela que tu cherches...

bonne journée
@+

 

[Youri]

Re : Problème as SaveAsUI

Bonjour Pierrot,

Merci pour ton aide, mais justement, quand je fais ça, ça n'a aucun effet. C'est quand même étrange. En tout cas, voici le code promis :

A placer dans ThisWorkbook, pour centraliser les processus :

Option Explicit
Option Base 1
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.EnableEvents = False
Dim Msg As String
Dim Ans As Variant
Dim der_enregistrement_pref_utilisateur As Long
marquer_sauvegarde_classeur = False
der_enregistrement_pref_utilisateur = ThisWorkbook.Worksheets("User_defined_settings").Range("B" & Rows.Count).End(xlUp).Row
If ThisWorkbook.Saved = True Then
Call gestion_sauvegarde(2)
Call load_user_preferences(der_enregistrement_pref_utilisateur)
marquer_sauvegarde_classeur = True
Call HideAll
Else
Msg = "Voulez-vous enregistrer les modifications apportées à la fiche de renseignements ?"
Ans = MsgBox(Msg, vbExclamation + vbYesNoCancel)
Select Case Ans
    Case vbYes
        Call gestion_sauvegarde(2)
        Call load_user_preferences(der_enregistrement_pref_utilisateur)
        marquer_sauvegarde_classeur = True
        Call HideAll
    Case vbNo
        Call gestion_sauvegarde(0)
        Call load_user_preferences(der_enregistrement_pref_utilisateur)
        marquer_sauvegarde_classeur = True
        Call HideAll
        Exit Sub
    Case vbCancel
        Cancel = True
        Exit Sub
End Select
End If
Application.EnableEvents = True
End Sub
Private Sub Workbook_Open()
Application.EnableEvents = False
Application.ScreenUpdating = False
Call ShowAll
Call gestion_sauvegarde(1)
If WorksheetFunction.CountA(ThisWorkbook.Worksheets("User_defined_settings").Cells) > 0 And ThisWorkbook.Worksheets("User_defined_settings").Range("A" & Rows.Count).End(xlUp).Value <> "" And ThisWorkbook.Worksheets("User_defined_settings").Range("A" & Rows.Count).End(xlUp).Value <> 0 And ThisWorkbook.Worksheets("User_defined_settings").Range("A" & Rows.Count).End(xlUp).Value <> "Closed" Then
    UF_Affichage.Show
    Else
    Call clean_history
    Call set_backup_environment
    Call apply_workbook_settings
End If
ThisWorkbook.Save
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim MonChoix As Variant
Cancel = True
If Not SaveAsUI Then
    Call gestion_sauvegarde(1)
    ThisWorkbook.Save
    ThisWorkbook.Saved = True
    Else
    MonChoix = Application.GetSaveAsFilename(ThisWorkbook.Name, "Classeur Microsoft Office Excel (*.xls), *.xls")
End If
If Not MonChoix = False Then
    ThisWorkbook.SaveAs Filename:=MonChoix, FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    Call gestion_sauvegarde(1)
    ThisWorkbook.Save
    ThisWorkbook.Saved = True
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[Youri]

Re : Problème as SaveAsUI

A placer dans un module extérieur - partie 1 (ex : mise_en_place_affichage), pour régler l'affichage :

Option Explicit
Option Base 1
Private taille_excel As Long
Sub clean_history()
taille_excel = Rows.Count
If ThisWorkbook.Worksheets("User_defined_settings").Range("B" & taille_excel).End(xlUp).Value > 2 Then
ThisWorkbook.Worksheets("User_defined_settings").Rows(ThisWorkbook.Worksheets("User_defined_settings").Range("B1").Row & ":" & (ThisWorkbook.Worksheets("User_defined_settings").Range("B2").End(xlDown).Row - 1)).Delete shift:=xlUp
ThisWorkbook.Worksheets("User_defined_settings").Range("B1").Value = 1
ThisWorkbook.Worksheets("User_defined_settings").Range("B2").End(xlDown).Value = 2
End If
End Sub
Sub set_backup_environment()
Dim debut_bak As Long
Dim i_mise_en_place As Long
Dim rep_cel_non_vide(1 To 24) As Long
Dim index_bak As Long
taille_excel = Rows.Count
If WorksheetFunction.CountA(ThisWorkbook.Worksheets("User_defined_settings").Range("A1:Y1")) = 0 Then
    debut_bak = 1
    index_bak = 1
    Else
    For i_mise_en_place = 1 To 24
        rep_cel_non_vide(i_mise_en_place) = ThisWorkbook.Worksheets("User_defined_settings").Cells(taille_excel, i_mise_en_place).End(xlUp).Row
    Next i_mise_en_place
    debut_bak = WorksheetFunction.Max(rep_cel_non_vide) + 2
    index_bak = ThisWorkbook.Worksheets("User_defined_settings").Range("B" & taille_excel).End(xlUp).Value + 1
End If
With ThisWorkbook.Worksheets("User_defined_settings")
    .Range("A" & debut_bak).Value = "Workbook_state"
    .Range("A" & debut_bak + 1).Value = "Open"
    .Range("B" & debut_bak).Value = index_bak
    .Range("C" & debut_bak).Value = "Bak_" & index_bak & "_App.RecentFiles.Max"
    .Range("D" & debut_bak).Value = "Bak_" & index_bak & "_App.RecentFiles.Name"
    .Range("E" & debut_bak).Value = "Bak_" & index_bak & "_App.DisplayRecentFiles"
    .Range("F" & debut_bak).Value = "Bak_" & index_bak & "_App.CellDragAndDrop"
    .Range("G" & debut_bak).Value = "Bak_" & index_bak & "_App.DisplayFormulaBar"
    .Range("H" & debut_bak).Value = "Bak_" & index_bak & "_App.DisplayStatusBar"
    .Range("I" & debut_bak).Value = "Bak_" & index_bak & "_App.CBars(Toolbar List).Enabled"
    .Range("J" & debut_bak).Value = "Bak_" & index_bak & "_App.CBars.AdaptiveMenus"
    .Range("K" & debut_bak).Value = "Bak_" & index_bak & "_App.CBars.FindControls(ID:=21).Enabled"
    .Range("L" & debut_bak).Value = "Bak_" & index_bak & "_App.CBars.FindControls(ID:=22).Enabled"
    .Range("M" & debut_bak).Value = "Bak_" & index_bak & "_App.CBars.FindControls(ID:=775).Enabled"
    .Range("N" & debut_bak).Value = "Bak_" & index_bak & "_ActSh.DisplayAutomaticPageBreaks"
    .Range("O" & debut_bak).Value = "Bak_" & index_bak & "_App.CBars(Worksheet Menu Bar).Controls"
    .Range("P" & debut_bak).Value = "Bak_" & index_bak & "_ActWind.DisplayGridlines"
    .Range("Q" & debut_bak).Value = "Bak_" & index_bak & "_ActWind.DisplayHeadings"
    .Range("R" & debut_bak).Value = "Bak_" & index_bak & "_ActWind.DisplayWorkbookTabs"
    .Range("S" & debut_bak).Value = "Bak_" & index_bak & "_CBars.Enabled"
    .Range("T" & debut_bak).Value = "Bak_" & index_bak & "_App.CBars.Controls.FindControl(ID:=19, Recursive:=True).Enabled"
    .Range("U" & debut_bak).Value = "Bak_" & index_bak & "_App.CommandBars(1).Controls.Visible"
    .Range("V" & debut_bak).Value = "Bak_" & index_bak & "_App.Calculation"
    .Range("W" & debut_bak).Value = "Bak_" & index_bak & "_App.EnableAnimations"
    .Range("X" & debut_bak).Value = "Bak_" & index_bak & "_Now"
End With
Call save_user_defined_settings
End Sub

 

[Youri]

Re : Problème as SaveAsUI

Module affichage partie 2 :

Sub save_user_defined_settings()
On Error Resume Next
Dim Cbar As Variant
Dim Ctl As CommandBarControl
Dim compte_bar As Integer
Dim IDnum As Variant
Dim N As Integer
Dim ctrl_des As CommandBarControl
Dim ctrl_1 As CommandBarControl
Dim ctrl_2 As CommandBarControl
Dim oCtrl As Office.CommandBarControl
Dim indice_fichier_recent As Long
With ThisWorkbook.Worksheets("User_defined_settings")
    .Range("C" & taille_excel).End(xlUp).Offset(1, 0).Value = Application.RecentFiles.Maximum
    For indice_fichier_recent = 1 To Application.RecentFiles.Count
        .Range("D" & taille_excel).End(xlUp).Offset(1, 0).Value = Application.RecentFiles(indice_fichier_recent).Name
    Next
    .Range("E" & taille_excel).End(xlUp).Offset(1, 0).Value = Application.DisplayRecentFiles
    .Range("F" & taille_excel).End(xlUp).Offset(1, 0).Value = Application.CellDragAndDrop
    .Range("G" & taille_excel).End(xlUp).Offset(1, 0).Value = Application.DisplayFormulaBar
    .Range("H" & taille_excel).End(xlUp).Offset(1, 0).Value = Application.DisplayStatusBar
    .Range("I" & taille_excel).End(xlUp).Offset(1, 0).Value = Application.CommandBars("Toolbar List").Enabled
    .Range("J" & taille_excel).End(xlUp).Offset(1, 0).Value = Application.CommandBars.AdaptiveMenus
    .Range("V" & taille_excel).End(xlUp).Offset(1, 0).Value = Application.Calculation
    .Range("W" & taille_excel).End(xlUp).Offset(1, 0).Value = Application.EnableAnimations
    .Range("X" & taille_excel).End(xlUp).Offset(1, 0).Value = Now()
    For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
        .Range("K" & taille_excel).End(xlUp).Offset(1, 0).Value = oCtrl.Enabled
    Next oCtrl
    For Each oCtrl In Application.CommandBars.FindControls(ID:=22)
        .Range("L" & taille_excel).End(xlUp).Offset(1, 0).Value = oCtrl.Enabled
    Next oCtrl
    For Each oCtrl In Application.CommandBars.FindControls(ID:=775)
        .Range("M" & taille_excel).End(xlUp).Offset(1, 0).Value = oCtrl.Enabled
    Next oCtrl
    .Range("N" & taille_excel).End(xlUp).Offset(1, 0).Value = ActiveSheet.DisplayAutomaticPageBreaks
    For Each ctrl_des In Application.CommandBars("Worksheet Menu Bar").Controls
        .Range("O" & taille_excel).End(xlUp).Offset(1, 0).Value = ctrl_des.Visible
    Next ctrl_des
    .Range("P" & taille_excel).End(xlUp).Offset(1, 0).Value = ActiveWindow.DisplayGridlines
    .Range("Q" & taille_excel).End(xlUp).Offset(1, 0).Value = ActiveWindow.DisplayHeadings
    .Range("R" & taille_excel).End(xlUp).Offset(1, 0).Value = ActiveWindow.DisplayWorkbookTabs
    For Each Cbar In Application.CommandBars
        .Range("S" & taille_excel).End(xlUp).Offset(1, 0).Value = Cbar.Enabled
    Next
    For compte_bar = 1 To Application.CommandBars.Count
        For Each Ctl In Application.CommandBars(compte_bar).Controls
            .Range("T" & taille_excel).End(xlUp).Offset(1, 0).Value = Application.CommandBars(compte_bar).FindControl(ID:=19, Recursive:=True).Enabled
        Next Ctl
    Next compte_bar
    For Each ctrl_1 In Application.CommandBars(1).Controls
        For Each ctrl_2 In ctrl_1.Controls
            .Range("U" & taille_excel).End(xlUp).Offset(1, 0).Value = ctrl_2.Visible
        Next ctrl_2
    Next ctrl_1
End With
On Error GoTo 0
End Sub
Sub apply_workbook_settings()
On Error Resume Next
Dim Cbar As Variant
Dim Ctl As CommandBarControl
Dim compte_bar As Integer
Dim IDnum As Variant
Dim N As Integer
Dim ctrl_des As CommandBarControl
Dim ctrl_1 As CommandBarControl
Dim ctrl_2 As CommandBarControl
Dim oCtrl As Office.CommandBarControl
Application.DisplayRecentFiles = False
Application.RecentFiles.Maximum = 0
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
    oCtrl.Enabled = False
Next oCtrl
For Each oCtrl In Application.CommandBars.FindControls(ID:=22)
    oCtrl.Enabled = False
Next oCtrl
For Each oCtrl In Application.CommandBars.FindControls(ID:=775)
    oCtrl.Enabled = False
Next oCtrl
ActiveSheet.DisplayAutomaticPageBreaks = False
With Application
    .CellDragAndDrop = False
    .DisplayFormulaBar = False
    .DisplayStatusBar = False
    .CommandBars("Toolbar List").Enabled = False
    .CommandBars.AdaptiveMenus = False
    .Calculation = xlCalculationManual
    .OnKey "^c", ""
    .OnKey "^v", ""
    .OnKey "^x", ""
    .OnKey "+{DEL}", ""
    .OnKey "^{INSERT}", ""
    .EnableAnimations = False
End With
For Each ctrl_des In Application.CommandBars("Worksheet Menu Bar").Controls
    If ctrl_des.ID <> 30002 And ctrl_des.ID <> 30010 Then
        ctrl_des.Visible = False
    End If
Next ctrl_des
With ActiveWindow
    .DisplayGridlines = False
    .DisplayHeadings = False
    .DisplayWorkbookTabs = False
End With
For Each Cbar In Application.CommandBars
    If Cbar.Name <> "Worksheet Menu Bar" Then
        Cbar.Enabled = False
    End If
Next
For compte_bar = 1 To Application.CommandBars.Count
    For Each Ctl In Application.CommandBars(compte_bar).Controls
        Application.CommandBars(compte_bar).FindControl(ID:=19, Recursive:=True).Enabled = False
    Next Ctl
Next compte_bar
For Each ctrl_1 In Application.CommandBars(1).Controls
    For Each ctrl_2 In ctrl_1.Controls
        ctrl_2.Visible = False
    Next ctrl_2
Next ctrl_1
IDnum = Array("106", "3", "748", "247", "109", "4", "752", "984", "1004", "3775", "7903", "927")
For N = LBound(IDnum) To UBound(IDnum)
    Application.CommandBars(1).FindControl(ID:=IDnum(N), Recursive:=True).Visible = True
Next N
On Error GoTo 0
End Sub

 

[Youri]

Re : Problème as SaveAsUI

Module affichage partie 3 :

Sub load_user_preferences(ByVal row_index As Long)
On Error Resume Next
Dim Cbar As Variant
Dim Ctl As CommandBarControl
Dim compte_bar As Integer
Dim ctrl_des As CommandBarControl
Dim ctrl_1 As CommandBarControl
Dim ctrl_2 As CommandBarControl
Dim oCtrl As Office.CommandBarControl
Dim row_index_boucles As Long
Dim indice_fichier_recent As Long
taille_excel = Rows.Count
Application.DisplayRecentFiles = ThisWorkbook.Worksheets("User_defined_settings").Range("E" & row_index + 1)
Application.RecentFiles.Maximum = ThisWorkbook.Worksheets("User_defined_settings").Range("C" & row_index + 1)
For indice_fichier_recent = ThisWorkbook.Worksheets("User_defined_settings").Range("D" & row_index).End(xlDown).Row To ThisWorkbook.Worksheets("User_defined_settings").Range("D" & row_index + 1).Row Step -1
    Application.RecentFiles.Add Name:=ThisWorkbook.Worksheets("User_defined_settings").Range("D" & indice_fichier_recent)
Next
row_index_boucles = row_index + 1
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
    oCtrl.Enabled = ThisWorkbook.Worksheets("User_defined_settings").Range("K" & row_index_boucles)
    row_index_boucles = row_index_boucles + 1
Next oCtrl
row_index_boucles = row_index + 1
For Each oCtrl In Application.CommandBars.FindControls(ID:=22)
    oCtrl.Enabled = ThisWorkbook.Worksheets("User_defined_settings").Range("L" & row_index_boucles)
    row_index_boucles = row_index_boucles + 1
Next oCtrl
row_index_boucles = row_index + 1
For Each oCtrl In Application.CommandBars.FindControls(ID:=775)
    oCtrl.Enabled = ThisWorkbook.Worksheets("User_defined_settings").Range("M" & row_index_boucles)
    row_index_boucles = row_index_boucles + 1
Next oCtrl
With Application
    .CellDragAndDrop = ThisWorkbook.Worksheets("User_defined_settings").Range("F" & row_index + 1)
    .DisplayFormulaBar = ThisWorkbook.Worksheets("User_defined_settings").Range("G" & row_index + 1)
    .DisplayStatusBar = ThisWorkbook.Worksheets("User_defined_settings").Range("H" & row_index + 1)
    .CommandBars("Toolbar List").Enabled = ThisWorkbook.Worksheets("User_defined_settings").Range("I" & row_index + 1)
    .CommandBars.AdaptiveMenus = ThisWorkbook.Worksheets("User_defined_settings").Range("J" & row_index + 1)
    .Calculation = ThisWorkbook.Worksheets("User_defined_settings").Range("V" & row_index + 1)
    .EnableAnimations = ThisWorkbook.Worksheets("User_defined_settings").Range("W" & row_index + 1)
    .OnKey "^c"
    .OnKey "^v"
    .OnKey "^x"
    .OnKey "+{DEL}"
    .OnKey "^{INSERT}"
End With
With ActiveWindow
    .DisplayGridlines = ThisWorkbook.Worksheets("User_defined_settings").Range("P" & row_index + 1)
    .DisplayHeadings = ThisWorkbook.Worksheets("User_defined_settings").Range("Q" & row_index + 1)
    .DisplayWorkbookTabs = ThisWorkbook.Worksheets("User_defined_settings").Range("R" & row_index + 1)
End With
ActiveSheet.DisplayAutomaticPageBreaks = ThisWorkbook.Worksheets("User_defined_settings").Range("N" & row_index + 1)
row_index_boucles = row_index + 1
For Each ctrl_des In Application.CommandBars("Worksheet Menu Bar").Controls
    ctrl_des.Visible = ThisWorkbook.Worksheets("User_defined_settings").Range("O" & row_index_boucles).Value
    row_index_boucles = row_index_boucles + 1
Next ctrl_des
row_index_boucles = row_index + 1
For Each Cbar In Application.CommandBars
        Cbar.Enabled = ThisWorkbook.Worksheets("User_defined_settings").Range("S" & row_index_boucles)
        row_index_boucles = row_index_boucles + 1
Next
row_index_boucles = row_index + 1
For compte_bar = 1 To Application.CommandBars.Count
    For Each Ctl In Application.CommandBars(compte_bar).Controls
        Application.CommandBars(compte_bar).FindControl(ID:=19, Recursive:=True).Enabled = ThisWorkbook.Worksheets("User_defined_settings").Range("T" & row_index_boucles)
        row_index_boucles = row_index_boucles + 1
    Next Ctl
Next compte_bar
row_index_boucles = row_index + 1
For Each ctrl_1 In Application.CommandBars(1).Controls
    For Each ctrl_2 In ctrl_1.Controls
        ctrl_2.Visible = ThisWorkbook.Worksheets("User_defined_settings").Range("U" & row_index_boucles)
        row_index_boucles = row_index_boucles + 1
    Next ctrl_2
Next ctrl_1
On Error GoTo 0
ThisWorkbook.Worksheets("User_defined_settings").Range("A" & taille_excel).End(xlUp).Value = "Closed"
End Sub
Sub reset_application_defaults()
On Error Resume Next
Dim Cbar As Variant
Dim Ctl As CommandBarControl
Dim compte_bar As Integer
Dim ctrl_des As CommandBarControl
Dim ctrl_1 As CommandBarControl
Dim ctrl_2 As CommandBarControl
Dim oCtrl As Office.CommandBarControl
Dim row_index As Long
Dim row_index_boucles As Long
Dim indice_fichier_recent As Long
Application.DisplayRecentFiles = True
Application.RecentFiles.Maximum = 4
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
    oCtrl.Enabled = True
Next oCtrl
For Each oCtrl In Application.CommandBars.FindControls(ID:=22)
    oCtrl.Enabled = True
Next oCtrl
For Each oCtrl In Application.CommandBars.FindControls(ID:=775)
    oCtrl.Enabled = True
Next oCtrl
With Application
    .CellDragAndDrop = True
    .DisplayFormulaBar = True
    .DisplayStatusBar = True
    .CommandBars("Toolbar List").Enabled = True
    .CommandBars.AdaptiveMenus = True
    .Calculation = xlCalculationAutomatic
    .OnKey "^c"
    .OnKey "^v"
    .OnKey "^x"
    .OnKey "+{DEL}"
    .OnKey "^{INSERT}"
End With
With ActiveWindow
    .DisplayGridlines = True
    .DisplayHeadings = True
    .DisplayWorkbookTabs = True
End With
ActiveSheet.DisplayAutomaticPageBreaks = False
For Each ctrl_des In Application.CommandBars("Worksheet Menu Bar").Controls
    ctrl_des.Visible = True
Next ctrl_des
For Each Cbar In Application.CommandBars
        Cbar.Enabled = True
Next
For compte_bar = 1 To Application.CommandBars.Count
    For Each Ctl In Application.CommandBars(compte_bar).Controls
        Application.CommandBars(compte_bar).FindControl(ID:=19, Recursive:=True).Enabled = True
    Next Ctl
Next compte_bar
For Each ctrl_1 In Application.CommandBars(1).Controls
    For Each ctrl_2 In ctrl_1.Controls
        ctrl_2.Visible = True
    Next ctrl_2
Next ctrl_1
On Error GoTo 0
End Sub

 

[Youri]

Re : Problème as SaveAsUI

A placer dans un autre module extérieur - afin de masquer/afficher des onglets à l'ouverture du fichier.

Option Explicit
Option Base 1
Public marquer_sauvegarde_classeur As Boolean
Dim FeuilleInformations As Variant
Sub HideAll()
Application.EnableEvents = False
Application.ScreenUpdating = False
Worksheets("Informations").Visible = xlSheetVisible
Worksheets("Fiche de renseignements").Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
If marquer_sauvegarde_classeur = True Then
ThisWorkbook.Save
ThisWorkbook.Saved = True
End If
Application.EnableEvents = True
End Sub
Sub ShowAll()
Worksheets("Fiche de renseignements").Visible = xlSheetVisible
    On Error Resume Next
    ThisWorkbook.Worksheets("Fiche de renseignements (2)").Visible = True
    If Err.Number = 0 Then
        Application.DisplayAlerts = False
        ThisWorkbook.Worksheets("Fiche de renseignements (2)").Delete
        ThisWorkbook.Worksheets("Fiche de renseignements").Copy After:=Worksheets("Fiche de renseignements")
        Application.EnableEvents = True
        ThisWorkbook.Worksheets("Fiche de renseignements").Activate
        Application.EnableEvents = False
        ThisWorkbook.Worksheets("Fiche de renseignements (2)").Visible = xlSheetVeryHidden
        Application.DisplayAlerts = True
        On Error GoTo 0
        Else
        ThisWorkbook.Worksheets("Fiche de renseignements").Copy After:=Worksheets("Fiche de renseignements")
        Application.EnableEvents = True
        ThisWorkbook.Worksheets("Fiche de renseignements").Activate
        Application.EnableEvents = False
        ThisWorkbook.Worksheets("Fiche de renseignements (2)").Visible = xlSheetVeryHidden
        On Error GoTo 0
    End If
Worksheets("Informations").Visible = xlSheetVeryHidden
End Sub
Sub gestion_sauvegarde(ByVal Cas As Byte)
Select Case Cas
    Case 0
    On Error Resume Next
    ThisWorkbook.Worksheets("Fiche de renseignements (2)").Visible = True
    If Err.Number = 0 Then
        Application.DisplayAlerts = False
        ThisWorkbook.Worksheets("Fiche de renseignements").Delete
        ThisWorkbook.Worksheets("Fiche de renseignements (2)").Name = "Fiche de renseignements"
        Application.DisplayAlerts = True
        On Error GoTo 0
    Else
        On Error GoTo 0
    End If
    Case 1
    On Error Resume Next
    ThisWorkbook.Worksheets("Fiche de renseignements (2)").Visible = True
    If Err.Number = 0 Then
        Application.DisplayAlerts = False
        ThisWorkbook.Worksheets("Fiche de renseignements (2)").Delete
        ThisWorkbook.Worksheets("Fiche de renseignements").Copy After:=Worksheets("Fiche de renseignements")
        ThisWorkbook.Worksheets("Fiche de renseignements").Activate
        ThisWorkbook.Worksheets("Fiche de renseignements (2)").Visible = xlSheetVeryHidden
        Application.DisplayAlerts = True
        On Error GoTo 0
        Else
        ThisWorkbook.Worksheets("Fiche de renseignements").Copy After:=Worksheets("Fiche de renseignements")
        ThisWorkbook.Worksheets("Fiche de renseignements").Activate
        ThisWorkbook.Worksheets("Fiche de renseignements (2)").Visible = xlSheetVeryHidden
        On Error GoTo 0
    End If
    Case 2
    On Error Resume Next
    ThisWorkbook.Worksheets("Fiche de renseignements (2)").Visible = True
    If Err.Number = 0 Then
        Application.DisplayAlerts = False
        ThisWorkbook.Worksheets("Fiche de renseignements (2)").Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        Else
        On Error GoTo 0
    End If
End Select
End Sub

 

[Youri]

Re : Problème as SaveAsUI

Ce code est bien évidemment à adapter selon le besoin. Attention : il s'agit d'un code qui modifie l'affichage d'Excel et qui supprime/ajoute automatiquement des onglets. Il est donc à manipuler avec les plus grandes précautions.
En cas de problème avec l'affichage, il suffit d'exécuter Sub reset_application_defaults() afin de remettre les réglages par défaut d'Excel.
Les UserForms qui vont avec sont disponibles sur demande (je peux bien évidemment poster le code de ces UserForms mais sans les UserForms eux-même ce ne sera pas vraiment utile)

Voilà, bonne journée à tous,
Youri

 

[Youri]

Re : Problème as SaveAsUI

Bonjour à tous,

Je viens de mettre à jour le code. Plus simple, plus efficace ... En espérant que ça puisse aider quelqu'un.

Bonne journée,
Youri