Ограничить возможность доступа пользователя к диалоговому окну (запрет нажатия кнопки "Открыть")

@Оляля · Регистрация: 04.03.2012

Студворк — интернет-сервис помощи студентам

Здравствуйте! Нужно ограничить возможность пользователя доступа к диалоговому окну, чтобы он не мог воспользоваться кнопочкой "Открыть".Функции Сохранение и Печать(чтобы не получить доступ к проводнику через выбор принтера) ограничены. Подскажите пожалуйста.

Сохраняется в определенную директорию, воспользовавшись формой, пользователь не получает доступа к рабочему столу.

Visual Basic
1
2
3
4
5
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
        Cancel As Boolean)
        Frm_Save.Show
 Exit Sub
End Sub

Ограничивается доступ к просмотру принтеров через проводник.

Visual Basic
1
2
3
4
Private Sub workbook_BeforePrint(Cancel As Boolean)
    Cancel = True
    MsgBox "К сожалению, вы не можете печатать этот файл", vbInformation
End Sub

@Sasha_Smirnov · 30.12.2014, 13:18

Сообщение от Оляля

Visual Basic
1
"К сожалению, вы не можете печатать этот файл"

Тогда уж не к сожалению*! Я бы PrtScr нажал.
__________________________
*

"К счастью, вы не можете печатать этот файл"
"Хихи, вы не можете печатать этот файл"
"Ахаха, вы не можете печатать этот файл"
"К сожалению, вы можете печатать этот файл, лишь посетив страницу cyberforum.ru/vba/thread1344429.htm"

@Alex77755 · 30.12.2014, 20:14

В модуль:

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
Public ComBar As CommandBar
Public ComBarCtrl As CommandBarControl
Sub EnableAllClear()
'// Команда Вставка (Insert)..
EnableControl 295, True '// ..Ячейки (Cells)
EnableControl 296, True '// ..Строки (Rows)
EnableControl 297, True '// ..Столбцы (Columns)
'// Команда...
EnableControl 478, True '// Правка->Удалить (Edit->Delete)
EnableControl 292, True '// Удалить (Delete), контекстное
'// меню ячейки
EnableControl 293, True '// Удалить строки (Delete Rows),
'// контекстное меню строки
EnableControl 294, True '// Удалить (Delete), контекстное
'// меню столбца
EnableControl 847, True '// Правка->Удалить лист
'// (Edit->Delete Sheet)
'// Команда...
EnableControl 3125, True '// Очистить содержимое (Clear
'// Contents), контекстное меню
EnableControl 1964, True '// Правка->Очистить->Все (All)
EnableControl 872, True '// Правка->Очистить->Форматы
'// (Edit->Clear->Formats)
EnableControl 873, True '// Правка->Очистить->Содержимое
'// (Edit->Clear->Contents)
EnableControl 874, True '// Правка->Очистить->Примечания
'// (Edit->Clear->Comments)
'// Команда...
EnableControl 21, True '// Вырезать (Cut)
EnableControl 19, True '// Копировать (Copy)
EnableControl 22, True '// Вставить (Paste)
EnableControl 755, True '// Специальная вставка
EnableControl 30017, True '// Сервис/Макрос
'Работа с "Листами"
EnableControl 847, True
EnableControl 848, True
EnableControl 852, True
EnableControl 30026, True
'Параметры страницы
EnableControl 247, True
'// (Paste Special)
'// Комбинации клавиш.
With Application
.OnKey "^a"
.OnKey "^c"
.OnKey "^v"
.OnKey "+{DEL}"
.OnKey "+{INSERT}"
.OnKey "^{INSERT}"
 
.CellDragAndDrop = True
.OnDoubleClick = ""
End With
'// Панели инструментов.
CommandBars("ToolBar List").Enabled = True
End Sub
Sub DisAbleAllCLear()
'// Команда Вставка (Insert)..
EnableControl 295, False '// ..Ячейки (Cells)
EnableControl 296, False '// ..Строки (Rows)
EnableControl 297, False '// ..Столбцы (Columns)
'// Команда...
EnableControl 478, False '// Правка->Удалить (Edit->Delete)
EnableControl 292, False '// Удалить (Delete), контекстное
'// меню ячейки
EnableControl 293, False '// Удалить строки (Delete Rows),
'// контекстное меню строки
EnableControl 294, False '// Удалить (Delete), контекстное
'// меню столбца
EnableControl 847, False '// Правка->Удалить лист
'// (Edit->Delete Sheet)
'// Команда...
EnableControl 21, False '// Вырезать (Cut)
EnableControl 19, False '// Копировать (Copy)
EnableControl 22, False '// Вставить (Paste)
EnableControl 755, False '// Специальная вставка
EnableControl 30017, False '// Сервис/Макрос
'Работа с "Листами"
EnableControl 847, False
EnableControl 848, False
EnableControl 852, False
EnableControl 30026, False
'Параметры страницы
EnableControl 247, False
'// (Paste Special)
'// Команда...
EnableControl 3125, False '// Очистить содержимое (Clear
'// Contents), контекстное меню
EnableControl 1964, False '// Правка->Очистить->Все (All)
EnableControl 872, False '// Правка->Очистить->Форматы
'// (Edit->Clear->Formats)
EnableControl 873, False '// Правка->Очистить->Содержимое
'// (Edit->Clear->Contents)
EnableControl 874, False '// Правка->Очистить->Примечания
'// (Edit->Clear->Comments)
'// Комбинации клавиш.
With Application
.OnKey "^a", "Dummy"
.OnKey "^c", "Dummy"
.OnKey "^v", "Dummy"
.OnKey "+{DEL}", "Dummy"
.OnKey "+{INSERT}", "Dummy"
.OnKey "^{INSERT}", "Dummy"
.CellDragAndDrop = False
.OnDoubleClick = "Dummy"
End With
'// Панели инструментов.
CommandBars("ToolBar List").Enabled = False
End Sub
Sub EnableControl(iId As Integer, blnState As Boolean)
Dim ComBar As CommandBar
Dim ComBarCtrl As CommandBarControl
On Error Resume Next
For Each ComBar In Application.CommandBars
Set ComBarCtrl = ComBar.FindControl(ID:=iId, recursive:=True)
If Not ComBarCtrl Is Nothing Then ComBarCtrl.Enabled = blnState
Next
End Sub
Sub Dummy()
'// Вывод сообщения.
MsgBox "Команда недоступна!"
End Sub

В эта книга:

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
Private Sub Workbook_Open()
    Run "DisAbleAllCLear"
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    EnableAllClear
End Sub

@Оляля · 31.12.2014, 06:43 **[ТС]**

Alex77755,

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub ChangeInterface(Value As Boolean)
    With Application
        .ScreenUpdating = False
        .Caption = IIf(Value = True, Empty, ActiveWorkbook.Windows(1).Caption)
        .DisplayStatusBar = Value: .DisplayFormulaBar = Value
        Dim iCommandBar As CommandBar
        For Each iCommandBar In .CommandBars
            iCommandBar.Enabled = Value
        Next
        With .ActiveWindow
            .Caption = IIf(Value = True, .Parent.Name, "")
        End With
        .ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", " & Value & ")"
        .ScreenUpdating = True
    End With
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", False)"
End Sub

Нашла вот так и + восстанавливаю интерфейс при закрытии и перехода на другую активную книгу. Подскажите пожалуйста, где ошибка здесь: должно копировать лист из одной книги и создавать новую, вставляя скопированный дист в новую книгу. Книгу создает, но пустую. Заранее спасибо.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub CommandButton1_Click()
Const REPORTS_FOLDER = "Отчеты\"
Dim wb As Workbook
Set wb = Workbooks.Add
Sheets("Лист1").Copy
With wb
.SaveAs Filename:=ThisWorkbook.Path & "\" & REPORTS_FOLDER & TextBox1.Value _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Range("A1").Select
ActiveSheet.Paste
Range("J18").Select
End With
ActiveWorkbook.Close False
End Sub
 
Private Sub UserForm_Initialize()
    Me.TextBox1 = ActiveWorkbook.Windows(1).Caption
End Sub

@Апострофф · 31.12.2014, 06:57

Сообщение от Оляля

Visual Basic
1
2
3
4
Dim wb As Workbook
Set wb = Workbooks.Add
Sheets("Лист1").Copy
With wb

Сообщение от Оляля

Книгу создает, но пустую.

Поменяйте (исправьте) приведенный фрагмент на такой -

Visual Basic
1
2
3
4
Dim wb As Workbook
Sheets("Лист1").Copy
Set wb = activeWorkbook 's.Add
With wb

?

@Оляля · 31.12.2014, 07:00 **[ТС]**

Апострофф, еще вопрос, а как без макросов скопировать?

@Апострофф · 31.12.2014, 07:16

Сообщение от Оляля

как без макросов скопировать?

Правой кнопкой мыши по ярлыку листа -> Переместить/скопировать ...

@Оляля · 31.12.2014, 08:14 **[ТС]**

Апострофф, у меня всё равно не копирует((

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CommandButton1_Click()
Const REPORTS_FOLDER = "Отчеты\"
Dim wb As Workbook
Sheets("Лист1").Copy
Set wb = ActiveWorkbook 
With wb
.SaveAs Filename:=ThisWorkbook.Path & "\" & REPORTS_FOLDER & TextBox1.Value _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Range("A1").Select
ActiveSheet.Paste
Range("J18").Select
End With
ActiveWorkbook.Close False
End Sub

@Апострофф · 31.12.2014, 08:59

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CommandButton1_Click()
Const REPORTS_FOLDER = "Отчеты\"
Dim wb As Workbook
Sheets("Лист1").Copy 'копируем лист1 из активной книги в новую, которая становится активной автоматически
Set wb = ActiveWorkbook 
With wb
.SaveAs Filename:=ThisWorkbook.Path & "\" & REPORTS_FOLDER & TextBox1.Value _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'Range("A1").Select
'ActiveSheet.Paste - а вот это убираем!!!
'Range("J18").Select
End With
ActiveWorkbook.Close False 'а здесь надо разбираться, что хотим закрыть - оригинал или копию, которая в настоящий момент активна
End Sub

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Основы отладки веб-приложений на SDL3 по USB и Wi-Fi, запущенных в браузере мобильных устройств 8Observer8 07.02.2026 Содержание блога Браузер Chrome имеет средства для отладки мобильных веб-приложений по USB. В этой пошаговой инструкции ограничимся работой с консолью. Вывод в консоль - это часть процесса. . .	SDL3 для Web (WebAssembly): Обработчик клика мыши в браузере ПК и касания экрана в браузере на мобильном устройстве 8Observer8 02.02.2026 Содержание блога Для начала пошагово создадим рабочий пример для подготовки к экспериментам в браузере ПК и в браузере мобильного устройства. Потом напишем обработчик клика мыши и обработчик. . .	Философия технологии iceja 01.02.2026 На мой взгляд у человека в технических проектах остается роль генерального директора. Все остальное нейронки делают уже лучше человека. Они не могут нести предпринимательские риски, не могут. . .	SDL3 для Web (WebAssembly): Вывод текста со шрифтом TTF с помощью SDL3_ttf 8Observer8 01.02.2026 Содержание блога В этой пошаговой инструкции создадим с нуля веб-приложение, которое выводит текст в окне браузера. Запустим на Android на локальном сервере. Загрузим Release на бесплатный. . .
SDL3 для Web (WebAssembly): Сборка C/C++ проекта из консоли 8Observer8 30.01.2026 Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .	SDL3 для Web (WebAssembly): Установка Emscripten SDK (emsdk) и CMake для сборки C и C++ приложений в Wasm 8Observer8 30.01.2026 Содержание блога Для того чтобы скачать Emscripten SDK (emsdk) необходимо сначало скачать и уставить Git: Install for Windows. Следуйте стандартной процедуре установки Git через установщик. . . .	SDL3 для Android: Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 29.01.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами. Версия v3 была полностью переписана на Си, в. . .	Инструменты COM: Сохранение данный из VARIANT в файл и загрузка из файла в VARIANT bedvit 28.01.2026 Сохранение базовых типов COM и массивов (одномерных или двухмерных) любой вложенности (деревья) в файл, с возможностью выбора алгоритмов сжатия и шифрования. Часть библиотеки BedvitCOM Использованы. . .

@Оляля 1 / 1 / 0 Регистрация: 04.03.2012 Сообщений: 84
	31.12.2014, 07:00 [ТС]
	Апострофф, еще вопрос, а как без макросов скопировать? 0

Ограничить возможность доступа пользователя к диалоговому окну (запрет нажатия кнопки "Открыть")

Решение