🔒 Как запретить закрытие файла Excel?
Иногда бывает нужно защитить файл Excel от случайного закрытия, особенно если пользователь не должен его закрывать до завершения определённых действий. Это можно реализовать с помощью обработки события Workbook_BeforeClose.
Для того, чтобы всё-таки закрыть книгу, не прибегая к редактированию кода VBA, предусмотрен ввод пароля.
✅ Пример кода VBA, запрещающего закрывать файл Excel без пароля:
🔐 Теперь закрыть файл можно только с правильным паролем.
#VBA #ExcelVBA #Пароль #Закрыть #Книга #Файл
Иногда бывает нужно защитить файл Excel от случайного закрытия, особенно если пользователь не должен его закрывать до завершения определённых действий. Это можно реализовать с помощью обработки события Workbook_BeforeClose.
Для того, чтобы всё-таки закрыть книгу, не прибегая к редактированию кода VBA, предусмотрен ввод пароля.
✅ Пример кода VBA, запрещающего закрывать файл Excel без пароля:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim pass As String
pass = InputBox("Введите пароль для закрытия файла:")
If pass <> "123456" Then
MsgBox "Неверный пароль. Закрытие отменено.", vbCritical
Cancel = True
End If
End Sub
🔐 Теперь закрыть файл можно только с правильным паролем.
#VBA #ExcelVBA #Пароль #Закрыть #Книга #Файл
👍6🔥1
🔏 Дополнение к посту: «Снятие пароля с проекта VBA Excel»
Недавно встретил следующую рекомендацию по редактированию строки «DPB=...»:
5. Найди строку:
DPB=... (иногда DPX или похожее)
6. Замени её на:
DPB="
Решил проверить. Пробовал и так, как в рекомендации (DPB="), и с двумя двойными кавычками (DPB=""), и без кавычек (DPB=).
Результат во всех случаях был один и тот же: ✖️ полностью удален файл vbaProject.bin. ✖️
🚫 Вариант оказался не рабочий.
#VBA #ExcelVBA #Пароль #Защита #Проект #Снять
Недавно встретил следующую рекомендацию по редактированию строки «DPB=...»:
5. Найди строку:
DPB=... (иногда DPX или похожее)
6. Замени её на:
DPB="
Решил проверить. Пробовал и так, как в рекомендации (DPB="), и с двумя двойными кавычками (DPB=""), и без кавычек (DPB=).
Результат во всех случаях был один и тот же: ✖️ полностью удален файл vbaProject.bin. ✖️
🚫 Вариант оказался не рабочий.
#VBA #ExcelVBA #Пароль #Защита #Проект #Снять
👍1🤔1🙏1
🎯 Валидация ввода данных в поля формы VBA Excel
Когда пользователь заполняет форму в Excel, важно убедиться, что он вводит корректные значения. В примере ниже рассмотрены простые способы валидации введенных данных.
Пользовательская форма содержит:
1️⃣ TextBox1 — ввод имени (обязательное поле, мин. 3 символа)
2️⃣ TextBox2 — ввод возраста (только число)
3️⃣ TextBox3 — ввод Email (обязательное поле, с проверкой формата)
4️⃣ CommandButton1 — кнопка "Отправить"
Введенные данные записываются на новую строку листа "Анкеты".
📌 Пример:
💡 Примечания:
🔹 Возраст можно ограничить интервалом, например: от 10 до 110.
🔹 Вместо простенького шаблона "*@*.*" для проверки Email можно использовать регулярное выражение.
#VBA #ExcelVBA #Валидация #Ввод #Форма
Когда пользователь заполняет форму в Excel, важно убедиться, что он вводит корректные значения. В примере ниже рассмотрены простые способы валидации введенных данных.
Пользовательская форма содержит:
1️⃣ TextBox1 — ввод имени (обязательное поле, мин. 3 символа)
2️⃣ TextBox2 — ввод возраста (только число)
3️⃣ TextBox3 — ввод Email (обязательное поле, с проверкой формата)
4️⃣ CommandButton1 — кнопка "Отправить"
Введенные данные записываются на новую строку листа "Анкеты".
📌 Пример:
Private Sub CommandButton1_Click()
'Проверка имени на пустую строку
If Trim(TextBox1.Value) = "" Then
MsgBox "Пожалуйста, введите имя.", vbExclamation
TextBox1.SetFocus
Exit Sub
End If
'Проверка имени на количество символов
If Len(TextBox1.Value) < 3 Then
MsgBox "Имя должно содержать не менее 3 символов.", vbInformation
TextBox1.SetFocus
Exit Sub
End If
'Проверка возраста на число
If Not IsNumeric(TextBox2.Value) Then
MsgBox "Возраст должен быть числом.", vbExclamation
TextBox2.SetFocus
Exit Sub
End If
'Проверка Email на пустую строку
If Trim(TextBox3.Value) = "" Then
MsgBox "Пожалуйста, введите email.", vbExclamation
TextBox3.SetFocus
Exit Sub
End If
'Проверка Email по шаблону
If Not IsValidEmail(TextBox3.Value) Then
MsgBox "Неверный формат email.", vbCritical
TextBox3.SetFocus
Exit Sub
End If
'Отправка данных в таблицу
Dim ws As Worksheet
Dim nextRow As Long
Set ws = ThisWorkbook.Sheets("Анкеты")
nextRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(nextRow, 1).Value = TextBox1.Value 'Имя
ws.Cells(nextRow, 2).Value = TextBox2.Value 'Возраст
ws.Cells(nextRow, 3).Value = TextBox3.Value 'Email
MsgBox "Данные успешно отправлены!", vbInformation
Unload Me
End Sub
'Функция для проверки Email с помощью простого паттерна
Private Function IsValidEmail(email As String) As Boolean
IsValidEmail = email Like "*@*.*" And InStr(email, " ") = 0
End Function
💡 Примечания:
🔹 Возраст можно ограничить интервалом, например: от 10 до 110.
🔹 Вместо простенького шаблона "*@*.*" для проверки Email можно использовать регулярное выражение.
#VBA #ExcelVBA #Валидация #Ввод #Форма
👍5👏1
📠 Программное создание модуля и процедуры
Программное создание нового модуля и вставка в него новой процедуры из кода VBA Excel.
📌 Пример кода
После записи новой процедуры новый модуль автоматически получит фокус.
#VBA #ExcelVBA #Модуль #Процедура #Создание #Программно
Программное создание нового модуля и вставка в него новой процедуры из кода VBA Excel.
📌 Пример кода
Sub AddModuleAndSub()
'Создаем новый модуль
Dim newModule As Object
Set newModule = ThisWorkbook.VBProject.VBComponents.Add(1)
'Записываем новую процедуру
Dim n As Integer
With newModule.CodeModule
n = .CountOfLines
.InsertLines n + 1, "Sub NewSub()"
.InsertLines n + 2, "Dim s As String"
.InsertLines n + 3, " s = ""Это новый модуль и новая процедура!"""
.InsertLines n + 4, " MsgBox s"
.InsertLines n + 5, "End Sub"
End With
MsgBox "Новый модуль создан, новая процедура записана!"
End Sub
После записи новой процедуры новый модуль автоматически получит фокус.
#VBA #ExcelVBA #Модуль #Процедура #Создание #Программно
👍10
🔐 Генератор паролей на VBA Excel
Предложенный генератор создает случайный пароль из букв, цифр и символов и вставляет его в активную ячейку. Длина пароля указывается в коде.
📌 Код генератора паролей
💡 Примечания
1️⃣ Если вы хотите, чтобы в случайных паролях чаще встречались символы, удвойте их количество в переменной Chars. Точно также можно увеличить количество цифр.
2️⃣ По желанию, можно удалить из переменной Chars похожие знаки: [O][0] и [l][I][1].
#VBA #ExcelVBA #Генератор #Пароль #Создать
Предложенный генератор создает случайный пароль из букв, цифр и символов и вставляет его в активную ячейку. Длина пароля указывается в коде.
📌 Код генератора паролей
Sub InsertRandomPassword()
Dim Chars As String
Dim Password As String
Dim i As Integer
Dim Length As Integer
Length = 16 'Длина пароля, можно изменить
'Набор знаков для генерации пароля
Chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()-_=+"
'Инициализация генератора случайных чисел
Randomize
'Генерация пароля
For i = 1 To Length
Password = Password & Mid(Chars, Int(Rnd() * Len(Chars)) + 1, 1)
Next i
'Записываем пароль в активную ячейку
ActiveCell.Value = Password
End Sub
💡 Примечания
1️⃣ Если вы хотите, чтобы в случайных паролях чаще встречались символы, удвойте их количество в переменной Chars. Точно также можно увеличить количество цифр.
2️⃣ По желанию, можно удалить из переменной Chars похожие знаки: [O][0] и [l][I][1].
#VBA #ExcelVBA #Генератор #Пароль #Создать
👍5
📈 Значение параметра функции по умолчанию
С помощью оператора Optional можно не только объявить параметр функции как необязательный, но и присвоить ему значение по умолчанию.
📌 Пример 1
💡 Примечания
🔹 В этой функции, в отличии от функции ниже, можно указать для параметра d тип данных Double (и другие типы данных при необходимости).
🔹 Некоторые версии VBA не поддерживают значения по умолчанию для параметров с Optional, тогда нужно использовать другой подход, как во втором примере.
📌 Пример 2
💡 Примечание
🔹 Функция IsMissing возвращает True, если опциональный (необязательный) параметр типа Variant не передан при вызове. Поэтому во втором примере оставлено значение типа данных параметра d по умолчанию (Variant).
#VBA #ExcelVBA #Optional #Функция #Параметр #Значение
С помощью оператора Optional можно не только объявить параметр функции как необязательный, но и присвоить ему значение по умолчанию.
📌 Пример 1
Function SquareNumbers(Optional d As Double = 1.2) As Double
SquareNumbers = d * d
End Function
💡 Примечания
🔹 В этой функции, в отличии от функции ниже, можно указать для параметра d тип данных Double (и другие типы данных при необходимости).
🔹 Некоторые версии VBA не поддерживают значения по умолчанию для параметров с Optional, тогда нужно использовать другой подход, как во втором примере.
📌 Пример 2
Function SquareNumbers(Optional d)
If IsMissing(d) Then d = 1.2
SquareNumbers = d * d
End Function
💡 Примечание
🔹 Функция IsMissing возвращает True, если опциональный (необязательный) параметр типа Variant не передан при вызове. Поэтому во втором примере оставлено значение типа данных параметра d по умолчанию (Variant).
#VBA #ExcelVBA #Optional #Функция #Параметр #Значение
👍5❤1
🎛 Программное создание элементов управления
Рассмотрим программное (динамическое) создание элементов управления формы в VBA Excel для отображения расстояний от Солнца до планет Солнечной системы. Созданный элемент ComboBox будет реагировать на событие ComboBox_Change().
1️⃣ Создайте пользовательскую форму.
2️⃣ Разместите код в модуле формы.
📌 Код VBA Excel
Исправил незначительную ошибку, которая вызывала перенос строки в первой метке.
#VBA #ExcelVBA #Элемент #ComboBox #Label #Создание
Рассмотрим программное (динамическое) создание элементов управления формы в VBA Excel для отображения расстояний от Солнца до планет Солнечной системы. Созданный элемент ComboBox будет реагировать на событие ComboBox_Change().
1️⃣ Создайте пользовательскую форму.
2️⃣ Разместите код в модуле формы.
📌 Код VBA Excel
Option Explicit
'Объявляем переменные для создания меток
Dim lb1, lb2
'Объявляем переменную для поля со списком,
'которая будет обрабатывать события
'благодаря ключевому слову WithEvents
Private WithEvents cb1 As MSForms.ComboBox
Private Sub UserForm_Initialize()
With Me
.Height = 170
.Width = 305
.Caption = "Расстояние от Солнца до планет Солнечной системы"
'Программно создаем элементы управления
Set lb1 = .Controls.Add("Forms.Label.1")
Set lb2 = .Controls.Add("Forms.Label.1")
Set cb1 = .Controls.Add("Forms.ComboBox.1")
End With
With lb1
.Height = 22
.Width = 290
.Top = 60
.Left = 18
.Font.Size = 12
.Caption = "Расстояние от Солнца до выбранной планеты"
End With
With lb2
.Caption = ""
.Height = 22
.Width = 290
.Top = 90
.Left = 18
.Font.Size = 14
End With
With cb1
.Height = 22
.Width = 150
.Top = 20
.Left = 18
.Font.Size = 12
.List = Array("Меркурий", "Венера", "Земля", _
"Марс", "Юпитер", "Сатурн", "Уран", "Нептун")
.Value = "Выберите планету"
End With
End Sub
Private Sub cb1_Change()
Dim pl(), km()
pl = Array("Меркурия", "Венеры", "Земли", _
"Марса", "Юпитера", "Сатурна", "Урана", "Нептуна")
km = Array("57,91 млн км (0,387 а. е.)", "108 млн км (0,723 а. е.)", _
"149,6 млн км (1 а. е.)", "228 млн км (1,52 а. е.)", _
"778,57 млн км (5,2 а. е.)", "1,43 млрд км (9,58 а. е.)", _
"2,87 млрд км (19,1914 а. е.)", "4,55 млрд км (30,1 а. е.)")
If cb1.ListIndex > -1 Then
lb1.Caption = "Расстояние от Солнца до " & pl(cb1.ListIndex) & ":"
lb2.Caption = km(cb1.ListIndex)
End If
End Sub
Исправил незначительную ошибку, которая вызывала перенос строки в первой метке.
#VBA #ExcelVBA #Элемент #ComboBox #Label #Создание
👍6
✏️ Модификатор WithEvents в VBA Excel
WithEvents в VBA Excel используется при объявлении переменной, чтобы разрешить ей обрабатывать события объекта. Это позволяет, например, реагировать на нажатие кнопки или изменение текста в поле формы.
💡 Что такое WithEvents - оператор или ключевое слово?
📎 WithEvents — это:
✅ Ключевое слово (входит в синтаксис языка).
✅ Модификатор переменной (добавляет поддержку событий).
❌ Не оператор (не выполняет действий).
📍 Пример использования:
Теперь переменная Btn, после присвоения ей ссылки на кнопку, созданную методом Add, может вызывать, например, событие Btn_Click.
📚 Правила и ограничения WithEvents:
🔹 WithEvents используется только в модулях классов или формы, где требуется обработка событий объектов.
🔹 Нельзя использовать WithEvents для элемента структуры. Можно объявить только отдельные переменные, а не массивы WithEvents.
🔹 Переменная с WithEvents должна быть объявлена как объектная, но конкретного класса, который может вызывать события: As MSForms.Label, As MSForms.ComboBox, As MSForms.CommandButton и т.д. То есть, объявление As Object не подходит.
#VBA #ExcelVBA #WithEvents #Форма #Переменная #Событие
WithEvents в VBA Excel используется при объявлении переменной, чтобы разрешить ей обрабатывать события объекта. Это позволяет, например, реагировать на нажатие кнопки или изменение текста в поле формы.
💡 Что такое WithEvents - оператор или ключевое слово?
📎 WithEvents — это:
✅ Ключевое слово (входит в синтаксис языка).
✅ Модификатор переменной (добавляет поддержку событий).
❌ Не оператор (не выполняет действий).
📍 Пример использования:
Private WithEvents Btn As MSForms.CommandButton
Теперь переменная Btn, после присвоения ей ссылки на кнопку, созданную методом Add, может вызывать, например, событие Btn_Click.
📚 Правила и ограничения WithEvents:
🔹 WithEvents используется только в модулях классов или формы, где требуется обработка событий объектов.
🔹 Нельзя использовать WithEvents для элемента структуры. Можно объявить только отдельные переменные, а не массивы WithEvents.
🔹 Переменная с WithEvents должна быть объявлена как объектная, но конкретного класса, который может вызывать события: As MSForms.Label, As MSForms.ComboBox, As MSForms.CommandButton и т.д. То есть, объявление As Object не подходит.
#VBA #ExcelVBA #WithEvents #Форма #Переменная #Событие
👍7
💫 Удаляющаяся и приближающаяся строка
Кроме бегущей строки интересную анимацию можно создать с помощью удаляющихся и приближающихся строк.
Для создания эффекта удаляющейся и приближающейся строки используется функция Timer для задержки циклов, изменяющих размер шрифта.
1️⃣ Создайте пользовательскую форму.
2️⃣ Разместите код в модуле формы.
📌 Код VBA Excel
3️⃣ Запустите форму, надпись и кнопка будут созданы автоматически.
#VBA #ExcelVBA #Строка #РазмерШрифта #Удаление #Приближение
Кроме бегущей строки интересную анимацию можно создать с помощью удаляющихся и приближающихся строк.
Для создания эффекта удаляющейся и приближающейся строки используется функция Timer для задержки циклов, изменяющих размер шрифта.
1️⃣ Создайте пользовательскую форму.
2️⃣ Разместите код в модуле формы.
📌 Код VBA Excel
Option Explicit
'Объявляем переменную для создания метки
Private lblStroka As MSForms.Label
'Объявляем переменную для создания кнопки "Пуск" с поддержкой событий
Private WithEvents cmdPusk As MSForms.CommandButton
Private Sub cmdPusk_Click()
Dim i As Integer, Start As Single, Pause As Single
'Удаляющаяся строка
lblStroka.Caption = "Удаляющаяся строка"
For i = 180 To 5 Step -1
lblStroka.Font.Size = i / 5
Start = Timer
Pause = 0.02
Do While Timer < Start + Pause
DoEvents
Loop
Next
'Приближающаяся строка
lblStroka.Caption = "Приближающаяся строка"
For i = 5 To 180 Step 1
lblStroka.Font.Size = i / 5
Start = Timer
Pause = 0.02
Do While Timer < Start + Pause
DoEvents
Loop
Next
lblStroka.Caption = "Неподвижная строка"
End Sub
Private Sub UserForm_Initialize()
With Me
.Caption = "Удаляющаяся и приближающаяся строки"
.Height = 200
.Width = 500
Set lblStroka = .Controls.Add("Forms.Label.1")
Set cmdPusk = .Controls.Add("Forms.CommandButton.1")
End With
With lblStroka
.Height = 50
.Width = Me.Width
.Top = 30
.Left = 0
.Font.Size = 36
.TextAlign = fmTextAlignCenter
.Caption = "Неподвижная строка"
End With
With cmdPusk
.Caption = "Пуск"
.Height = 28
.Width = 80
.Top = 120
.Left = 216
.Font.Size = 12
End With
End Sub
3️⃣ Запустите форму, надпись и кнопка будут созданы автоматически.
#VBA #ExcelVBA #Строка #РазмерШрифта #Удаление #Приближение
👍11❤1
✅ Сумма прописью для документов
У вас есть собственноручно созданные в Excel бухгалтерские или юридические документы? 📚 Вы хотите, чтобы в этих документах денежные суммы автоматически конвертировались в суммы прописью?
Скопируйте функцию СуммаПрописью и вставьте ее в Личную книгу макросов, чтобы функция была доступна для любого файла Excel на вашем компьютере.
🛠 Код пользовательской функции СуммаПрописью:
💡 Примечание
Пользовательская функция СуммаПрописью преобразует денежное значение из числовой формы до 12 целочисленных разрядов включительно в сумму прописью следующего формата: 0,00 = Ноль рублей 00 копеек.
#VBA #ExcelVBA #СуммаПрописью #Документ
У вас есть собственноручно созданные в Excel бухгалтерские или юридические документы? 📚 Вы хотите, чтобы в этих документах денежные суммы автоматически конвертировались в суммы прописью?
Скопируйте функцию СуммаПрописью и вставьте ее в Личную книгу макросов, чтобы функция была доступна для любого файла Excel на вашем компьютере.
🛠 Код пользовательской функции СуммаПрописью:
Public Function СуммаПрописью(x As Double) As String
If x > 999999999999.99 Then
СуммаПрописью = "Аргумент больше 999 999 999 999.99!"
ElseIf x < 0 Then
СуммаПрописью = "Аргумент отрицательный!"
Else
x = FormatNumber(x, 2)
Dim b As Byte, b1 As Byte, b2 As Byte, kop As String
b = (x - Fix(x)) * 100
b2 = b \ 10
b1 = b Mod 10
If b2 <> 1 And b1 = 1 Then
kop = " копейка"
ElseIf b2 <> 1 And b1 > 1 And b1 < 5 Then
kop = " копейки"
Else
kop = " копеек"
End If
kop = b2 & b1 & kop
Dim y(1 To 4) As Integer, i1 As Byte
For i1 = 1 To 4
x = Fix(x) / 1000
y(i1) = (x - Fix(x)) * 1000
Next
Dim Text(1 To 4) As String, i2 As Byte, y1 As Byte, y2 As Byte, _
y3 As Byte, Text0 As String, Text1 As String, Text2 As String, Text3 As String, _
Text4 As String
For i2 = 1 To 4
y1 = y(i2) Mod 10
y2 = (y(i2) - y1) / 10 Mod 10
y3 = y(i2) \ 100
Text1 = Choose(y3 + 1, "", "сто ", "двести ", "триста ", "четыреста ", _
"пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
Text2 = Choose(y2 + 1, "", "", "двадцать ", "тридцать ", "сорок ", _
"пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
If y2 = 1 Then
Text3 = Choose(y1 + 1, "десять ", "одиннадцать ", "двенадцать ", _
"тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", _
"семнадцать ", "восемнадцать ", "девятнадцать ")
ElseIf y2 <> 1 And i2 = 2 Then
Text3 = Choose(y1 + 1, "", "одна ", "две ", "три ", "четыре ", "пять ", _
"шесть ", "семь ", "восемь ", "девять ")
Else
Text3 = Choose(y1 + 1, "", "один ", "два ", "три ", "четыре ", "пять ", _
"шесть ", "семь ", "восемь ", "девять ")
End If
If y2 <> 1 And y1 = 1 Then
Text4 = Choose(i2, "рубль ", "тысяча ", "миллион ", "миллиард ")
ElseIf y2 <> 1 And y1 > 1 And y1 < 5 Then
Text4 = Choose(i2, "рубля ", "тысячи ", "миллиона ", "миллиарда ")
ElseIf y1 = 0 And y2 = 0 And y3 = 0 Then
Text4 = Choose(i2, "рублей ", "", "", "")
Else
Text4 = Choose(i2, "рублей ", "тысяч ", "миллионов ", "миллиардов ")
End If
Text(i2) = Text1 & Text2 & Text3 & Text4
Next
If y(1) + y(2) + y(3) + y(4) = 0 Then
Text0 = "ноль рублей " & kop
Else
Text0 = Text(4) & Text(3) & Text(2) & Text(1) & kop
End If
СуммаПрописью = Replace(Text0, Left(Text0, 1), UCase(Left(Text0, 1)), 1, 1)
End If
End Function
💡 Примечание
Пользовательская функция СуммаПрописью преобразует денежное значение из числовой формы до 12 целочисленных разрядов включительно в сумму прописью следующего формата: 0,00 = Ноль рублей 00 копеек.
#VBA #ExcelVBA #СуммаПрописью #Документ
🔥6👍4
✍️ Дата прописью для документов
При заполнении доверенностей, договоров, соглашений, решений, уставов и других юридических документов требуется указание дат прописью. Если вы заполняете эти документы в Excel, есть простое решение с помощью VBA - функция ДатаПрописью.
Скопируйте функцию ДатаПрописью и вставьте ее в Личную книгу макросов, чтобы функция была доступна для любого файла Excel на вашем компьютере.
🛠 Код пользовательской функции ДатаПрописью:
💡 Функция ДатаПрописью преобразует даты из числового формата Excel в текст. Интервал преобразуемых дат: с 2001 по 2099 год.
#VBA #ExcelVBA #ДатаПрописью #Документ
При заполнении доверенностей, договоров, соглашений, решений, уставов и других юридических документов требуется указание дат прописью. Если вы заполняете эти документы в Excel, есть простое решение с помощью VBA - функция ДатаПрописью.
Скопируйте функцию ДатаПрописью и вставьте ее в Личную книгу макросов, чтобы функция была доступна для любого файла Excel на вашем компьютере.
🛠 Код пользовательской функции ДатаПрописью:
'Преобразование даты из числового формата в текст с 2001 по 2099 год
Public Function ДатаПрописью(md As Date) As String
If (md < 36892) Or (md > 73050) Then
ДатаПрописью = "Преобразуемая дата должна быть с 2001 по 2099 год!"
Else
Dim den As Byte, dg(1 To 4) As Byte, mes As Byte, god As Byte, _
mespr As String, dmgpr As String
den = Day(md)
mes = Month(md)
god = (Year(md) Mod 100)
dg(1) = god Mod 10
dg(2) = Fix(god / 10)
dg(3) = den Mod 10
dg(4) = Fix(den / 10)
Dim dgpr(1 To 4) As String, i1 As Byte
For i1 = 1 To 4
If (i1 = 1) Or (i1 = 3) Then
If dg(i1 + 1) = 1 Then
dgpr(i1) = Choose(dg(i1) + 1, "десятого ", "одиннадцатого ", "двенадцатого ", _
"тринадцатого ", "четырнадцатого ", "пятнадцатого ", "шестнадцатого ", _
"семнадцатого ", "восемнадцатого ", "девятнадцатого ")
Else
dgpr(i1) = Choose(dg(i1) + 1, "", "первого ", "второго ", _
"третьего ", "четвертого ", "пятого ", "шестого ", _
"седьмого ", "восьмого ", "девятого ")
End If
ElseIf (i1 = 2) Or (i1 = 4) Then
If dg(i1 - 1) = 0 Then
dgpr(i1) = Choose(dg(i1) + 1, "", "", "двадцатого ", _
"тридцатого ", "сорокового ", "пятидесятого ", "шестидесятого ", _
"семидесятого ", "восьмидесятого ", "девяностого ")
Else
dgpr(i1) = Choose(dg(i1) + 1, "", "", "двадцать ", _
"тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", _
"семьдесят ", "восемьдесят ", "девяносто ")
End If
End If
Next
mespr = Choose(mes, "января ", "февраля ", "марта ", "апреля ", "мая ", _
"июня ", "июля ", "августа ", "сентября ", "октября ", "ноября ", "декабря ")
dmgpr = dgpr(4) & dgpr(3) & mespr & "две тысячи " & dgpr(2) & dgpr(1) & "года"
ДатаПрописью = Replace(dmgpr, Left(dmgpr, 1), UCase(Left(dmgpr, 1)), 1, 1)
End If
End Function
💡 Функция ДатаПрописью преобразует даты из числового формата Excel в текст. Интервал преобразуемых дат: с 2001 по 2099 год.
#VBA #ExcelVBA #ДатаПрописью #Документ
👍5❤1
📅 Вставка текущей даты в ячейки Excel
У меня уже был пост на эту тему, но дата вставлялась в активную ячейку в текстовом формате с текстовым выравниванием. После редактирования даты или просто после вставки курсора в ячейку, дата пересохранялась в числовом формате со сменой выравнивания на противоположное. Внешний вид столбца с датами получался - не очень. Я подправил код, чтобы дата сразу вставлялась в числовом формате. 🚀
📌 Код для вставки текущей даты в активную ячейку:
1️⃣ Скопируйте процедуру InsertCurrentDate в стандартный модуль Личной книги макросов.
2️⃣ Перейдите из редактора VBA в Excel, сохраните текущую книгу и откройте окно "Макрос": Разработчик ➔ Макросы.
3️⃣ В списке макросов выберите процедуру PERSONAL.XLSB!InsertCurrentDate и нажмите кнопку "Параметры".
4️⃣ В поле "Сочетание клавиш:" впишите букву "й" (или другую свободную) и нажмите 🆗.
5️⃣ Сохраните текущую книгу и вставляйте текущую дату в ячейки Excel сочетанием клавиш Ctrl+й.
💡 Работа сочетания клавиш зависит от раскладки клавиатуры: если вы назначите - "й", будет работать только сочетание Ctrl+й, сочетание Ctrl+q работать не будет, и наоборот.
#VBA #ExcelVBA #Date #Ячейка #Дата #СочетаниеКлавиш
У меня уже был пост на эту тему, но дата вставлялась в активную ячейку в текстовом формате с текстовым выравниванием. После редактирования даты или просто после вставки курсора в ячейку, дата пересохранялась в числовом формате со сменой выравнивания на противоположное. Внешний вид столбца с датами получался - не очень. Я подправил код, чтобы дата сразу вставлялась в числовом формате. 🚀
📌 Код для вставки текущей даты в активную ячейку:
Sub InsertCurrentDate()
' Вставляем текущую дату в активную ячейку
With ActiveCell
.NumberFormat = "dd.mm.yyyy"
.Value = Date
End With
End Sub
1️⃣ Скопируйте процедуру InsertCurrentDate в стандартный модуль Личной книги макросов.
2️⃣ Перейдите из редактора VBA в Excel, сохраните текущую книгу и откройте окно "Макрос": Разработчик ➔ Макросы.
3️⃣ В списке макросов выберите процедуру PERSONAL.XLSB!InsertCurrentDate и нажмите кнопку "Параметры".
4️⃣ В поле "Сочетание клавиш:" впишите букву "й" (или другую свободную) и нажмите 🆗.
5️⃣ Сохраните текущую книгу и вставляйте текущую дату в ячейки Excel сочетанием клавиш Ctrl+й.
💡 Работа сочетания клавиш зависит от раскладки клавиатуры: если вы назначите - "й", будет работать только сочетание Ctrl+й, сочетание Ctrl+q работать не будет, и наоборот.
#VBA #ExcelVBA #Date #Ячейка #Дата #СочетаниеКлавиш
👍5😎1
💰 Курс валют
Проверил старую функцию на VBA Excel, возвращающую курс выбранной валюты в рублях. Оказалось, что она еще работает. 🚜
📌 Код функции
💡 Примечания
🔹 Параметры функции (КодВалюты и Дата) являются необязательными.
🔹 Если опустить параметр КодВалюты, будет применен код доллара.
🔹 Если опустить параметр Дата, будет применена текущая дата.
🔹 Если опустить оба параметра, будет возвращен курс доллара на текущую дату.
#VBA #ExcelVBA #КурсРубля #КурсДоллара #КурсЕвро #КурсЮаня
Проверил старую функцию на VBA Excel, возвращающую курс выбранной валюты в рублях. Оказалось, что она еще работает. 🚜
📌 Код функции
Function КурсВалют(Optional КодВалюты As String, Optional Дата As Date) As Double
Dim myXml As Object, myDate As String
Set myXml = CreateObject("msxml2.DOMDocument")
If Not CBool(Len(КодВалюты)) Then КодВалюты = "USD"
myDate = "?date_req=" & IIf(Дата, Дата, Date)
myXml.async = 0: myXml.Load ("http://www.cbr.ru/scripts/XML_daily.asp" & myDate)
With myXml.SelectSingleNode("*/Valute[CharCode='" & UCase(КодВалюты) & "']")
КурсВалют = CDbl(.ChildNodes(4).Text) / Val(.ChildNodes(2).Text)
End With
Set myXml = Nothing
End Function
💡 Примечания
🔹 Параметры функции (КодВалюты и Дата) являются необязательными.
🔹 Если опустить параметр КодВалюты, будет применен код доллара.
🔹 Если опустить параметр Дата, будет применена текущая дата.
🔹 Если опустить оба параметра, будет возвращен курс доллара на текущую дату.
#VBA #ExcelVBA #КурсРубля #КурсДоллара #КурсЕвро #КурсЮаня
👍5
🖥 Вывод списка приложений
С помощью кода VBA Excel можно вывести список установленных на компьютере приложений. 💫
Код процедуры достаточно длинный 📋, и Телеграм не дает возможности опубликовать его в тексте поста ✖️. Но вы можете скопировать его с сайта «Время не ждёт» по этой ссылке.
#VBA #ExcelVBA #СписокПриложений #СписокПрограмм
С помощью кода VBA Excel можно вывести список установленных на компьютере приложений. 💫
Код процедуры достаточно длинный 📋, и Телеграм не дает возможности опубликовать его в тексте поста ✖️. Но вы можете скопировать его с сайта «Время не ждёт» по этой ссылке.
#VBA #ExcelVBA #СписокПриложений #СписокПрограмм
Время не ждёт
VBA Excel. Список установленных приложений
Список установленных приложений может быть полезен не только в информационном плане для ознакомления с ним, но и для сохранения, например, на флэшку или
👍6
📝 Запись значений диапазона в обычную переменную
Чтобы вывести на экран значения диапазона методом Debug.Print, необходимо записать эти значения в обычную строковую переменную (не массив). Но массив тоже будем использовать, так как циклы в массивах работают быстрее, чем в диапазонах ячеек.
📌 Пример кода
Отображение на экране будет построчным, как в исходном диапазоне. Элементы диапазона будут разделены друг от друга точкой с запятой и пробелом.
#VBA #ExcelVBA #Диапазон #Значение #Переменная #DebugPrint
Чтобы вывести на экран значения диапазона методом Debug.Print, необходимо записать эти значения в обычную строковую переменную (не массив). Но массив тоже будем использовать, так как циклы в массивах работают быстрее, чем в диапазонах ячеек.
📌 Пример кода
Sub Primer()
Dim rng As Range, r&, c&, ar, i1&, i2&, txt$
Set rng = Worksheets("Лист4").Range("A1:F40")
With rng
r = .Rows.Count
c = .Columns.Count
ar = .Value
End With
For i1 = 1 To r
For i2 = 1 To c
txt = txt & ar(i1, i2)
If i2 = c Then
txt = txt & vbNewLine
Else
txt = txt & "; "
End If
Next
Next
Debug.Print txt
End Sub
Отображение на экране будет построчным, как в исходном диапазоне. Элементы диапазона будут разделены друг от друга точкой с запятой и пробелом.
#VBA #ExcelVBA #Диапазон #Значение #Переменная #DebugPrint
❤5👏1
📋 Выбор диапазона из таблицы
При ежедневном ведении базы данных (набора данных) в Excel таблица получается очень длинной. Она может содержать информацию о выручке по торговым точкам, о зарплатах сотрудников, о различных видах расходов и т.д. Анализировать такой набор данных и использовать его в целях учета приходится в разрезе интервалов дат, в соответствии с которыми необходимо осуществить выбор диапазона.
🛠 Функция для выбора диапазона
💫 Пример выбора диапазона
Пример использования функции для выбора диапазона с использованием формы для ручного или автоматического заполнения интервала дат:
💡 Примечания
1️⃣ Формат дат, загружаемых в функцию, должен соответствовать формату дат в наборе данных.
2️⃣ Код VBA Excel для первоначального тестирования отображает на экране (в окне Immediate) содержимое ячеек выбранного диапазона. Отображаются значения построчно, как в исходном диапазоне, с разделением друг от друга точкой с запятой и пробелом.
3️⃣ Обратите внимание, что в окне Immediate умещается ограниченное количество знаков — если диапазон большой, все значения могут не поместиться.
4️⃣ После удачного тестирования, строки кода для первоначального тестирования заменяются на строки кода для обработки выбранного диапазона.
#VBA #ExcelVBA #Выбор #Диапазон #Таблица
При ежедневном ведении базы данных (набора данных) в Excel таблица получается очень длинной. Она может содержать информацию о выручке по торговым точкам, о зарплатах сотрудников, о различных видах расходов и т.д. Анализировать такой набор данных и использовать его в целях учета приходится в разрезе интервалов дат, в соответствии с которыми необходимо осуществить выбор диапазона.
🛠 Функция для выбора диапазона
Function ВыборДиапазона(ИмяЛиста$, НачальнаяДата$, КонечнаяДата$) As Range
Dim МассивДанных As Variant, i&, n1&, n2&, rws&, cls&
'Отлавливаем всевозможные ошибки
On Error GoTo ПриОшибке
'Проверяем, чтобы начальная дата не превышала конечную
If CDate(НачальнаяДата) > CDate(КонечнаяДата) Then
MsgBox "Интервал дат задан неверно!"
Exit Function
End If
With Worksheets(ИмяЛиста).Range("A1").CurrentRegion
rws = .Rows.Count
cls = .Columns.Count
МассивДанных = .Value
End With
'Поиск начальной даты
For i = 1 To rws
If МассивДанных(i, 1) = НачальнаяДата Then
n1 = i
Exit For
End If
Next
'Поиск конечной даты
For i = rws To 1 Step -1
If МассивДанных(i, 1) = КонечнаяДата Then
n2 = i
Exit For
End If
Next
'Проверяем, что границы диапазона определены
If n1 = 0 Or n2 = 0 Then
MsgBox "Границы диапазона (или одна из границ) заданы неверно!"
Exit Function
End If
Set ВыборДиапазона = Worksheets(ИмяЛиста).Range(Cells(n1, 1), Cells(n2, cls))
Exit Function
ПриОшибке:
MsgBox "Ошибка: " & Err.Description
End Function
💫 Пример выбора диапазона
Пример использования функции для выбора диапазона с использованием формы для ручного или автоматического заполнения интервала дат:
Private Sub CommandButton6_Click()
Dim rng As Range
'Отлавливаем ошибки
On Error GoTo ПриОшибке
Set rng = ВыборДиапазона("Лист4", TextBox1.Text, TextBox2.Text)
If rng Is Nothing Then
MsgBox "Диапазон не выбран!"
Exit Sub
End If
'Строки кода для первоначального тестирования
Dim r&, c&, ar, i1&, i2&, txt$
With rng
r = .Rows.Count
c = .Columns.Count
ar = .Value
End With
For i1 = 1 To r
For i2 = 1 To c
txt = txt & ar(i1, i2)
If i2 = c Then
txt = txt & vbNewLine
Else
txt = txt & "; "
End If
Next
Next
Debug.Print txt
Exit Sub
ПриОшибке:
MsgBox "Ошибка: " & Err.Description
End Sub
💡 Примечания
1️⃣ Формат дат, загружаемых в функцию, должен соответствовать формату дат в наборе данных.
2️⃣ Код VBA Excel для первоначального тестирования отображает на экране (в окне Immediate) содержимое ячеек выбранного диапазона. Отображаются значения построчно, как в исходном диапазоне, с разделением друг от друга точкой с запятой и пробелом.
3️⃣ Обратите внимание, что в окне Immediate умещается ограниченное количество знаков — если диапазон большой, все значения могут не поместиться.
4️⃣ После удачного тестирования, строки кода для первоначального тестирования заменяются на строки кода для обработки выбранного диапазона.
#VBA #ExcelVBA #Выбор #Диапазон #Таблица
👍7🔥1