Всем Спасибо!
Все отладил, вот выкладываю код который есть у меня, может кому пригодиться для работы.
Я сам не специалист и использую те коды что уже написаны и самые простые команды до которых дотюкиваю сам, поэтому прошу сильно не кретиковать если написано что-то не совсем логично и можно написать проще.
К Module1 вписал 2 макроса, а именно:
Sub ПокажиМеня()
Application.ScreenUpdating = False
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", True)"
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = True
Application.ScreenUpdating = True
End Sub
Sub СпрячьМеня()
Application.ScreenUpdating = False
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", False)"
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = True
Application.ScreenUpdating = True
End Sub
В ThisWorkbook вписал следующее при помощи всех Вас и особенно The_Prist
Private WithEvents App As Application
Public Function lCountWorkbooks() As Long
Dim lCount As Long, wbBook As Workbook
For Each wbBook In Application.Workbooks
If wbBook.Windows(1).Visible Then lCount = lCount + 1
Next wbBook
lCountWorkbooks = lCount
End Function
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
Select Case MsgBox("Сохранить изменения в файле '" & Me.Name & "' ?", vbYesNo + vbQuestion, Title:="ООО ''Рога и копыта''")
Case vbYes: Module1.ПокажиМеня: Me.Save:
Case vbNo: Module1.ПокажиМеня: Me.Saved = True
End Select
Application.ScreenUpdating = True
Set App = Nothing
End Sub
Private Sub Workbook_Open()
Set App = Application
End Sub
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
Dim Msg As String
Msg = ("Файл Excel " & Me.Name & " может работать только один!" & vbCrLf & "Закройте " & Me.Name & " и открывайте любые другие файлы Excel и наобарот!")
If lCountWorkbooks > 1 Then
MsgBox Msg, vbCritical, "ООО ''Рога и Копыта''"
Wb.Close (SaveChanges = False)
End If
Application.ScreenUpdating = False
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayGridlines = False
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", False)"
Ëèñò1.ScrollArea = ("A1:AH122")
Ëèñò2.ScrollArea = ("A1:AL145")
Ëèñò3.ScrollArea = ("A1:G89")
Ëèñò4.ScrollArea = ("B7:E22")
Application.ScreenUpdating = True
Set App = Application
End Sub
В код каждого листа добавил свои свойства чтоб включить или отключить ненужные
Прочку к примерую:
На лист 1 вписал:
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", False)"
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = True
Application.ScreenUpdating = True
End Sub
На лист2 вписал:
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", False)"
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayHorizontalScrollBar = False
ActiveWindow.DisplayVerticalScrollBar = False
Application.ScreenUpdating = True
End Sub
Таким образом получился файл, который работает только когда он один и неиспользует никаких лишних функций, а самое главное ленту!
Становиться удобным для просмотра и приятным в использовании.
За отключение ленты отдельное спасибо МАСТЕРУ ЙОДА! Ник не помню, но на аватаре у него мастер ЙОДА!!!
С уважением,
Александр
