VBA Excel
241 subscribers
88 photos
23 links
VBA Excel для начинающих. Справка по VBA Excel. Visual Basic for Applications. Справочник. Самоучитель.
Download Telegram
📄 Добавление нового листа в оглавление
После добавления в книгу нового листа, с помощью предыдущего кода можно обновить оглавление. Но, если вы включили в оглавление какие-то дополнительные пометки и комментарии, они будут удалены вместе со старым листом "Оглавление". Чтобы сохранить пометки и комментарии, можно просто добавить ссылку на новый лист в существующее оглавление.

📌 Код VBA Excel:
Sub AddItemToTableOfContents()
Dim ws As String, n As LongLong
ws = ActiveSheet.Name
If MsgBox("Добавить лист «" & ws & "» в Оглавление?", 33) = 1 Then
Sheets("Оглавление").Activate
' Определяем номер строки первой незаполненной ячейки
n = Cells(Rows.Count, 1).End(xlUp).Row + 1
' Добавляем ссылку на активный лист
Cells(n, 1).Value = ws
ActiveSheet.Hyperlinks.Add Anchor:=Cells(n, 1), _
Address:="", SubAddress:="'" & ws & "'!A1", _
TextToDisplay:=ws
' Автоширина столбца
Columns("A").AutoFit
MsgBox "Лист «" & ws & "» добавлен в Оглавление!", vbInformation, "Готово!"
End If
End Sub


📌 Как работает макрос?
🔹 Спрашивает пользователя о необходимости добавления в оглавление ссылки на активный лист.
🔹 Если пользователь отвечает «OK», макрос записывает ссылку на активный лист в первую свободную ячейку первого столбца листа "Оглавление".

#VBA #ExcelVBA #Оглавление #Содержание #Hyperlinks #SubAddress
👍4
Примеры программ на VBA Excel
Бегущая строка
Валидация ввода данных в поля формы VBA Excel
Вставка интервала дат (DateAdd)
Вставка интервала дат (DateSerial)
Вставка текущей даты в ячейки Excel
Выбор позиции в списке
Вывод разрешения экрана
Вывод списка листов
Выравнивание заголовка кодом VBA
Генератор паролей на VBA Excel
Добавление нового листа в оглавление
Запись значений диапазона в обычную переменную
Заполнение ComboBox названиями месяцев
Защита кода VBA паролем
Как запретить закрытие файла Excel?
Максимизация окна Excel при открытии
Необязательные параметры в VBA Excel
Номер последней заполненной строки
Обрезание расширения файла
Отбор уникальных значений из списка
Открыть сайт или файл для просмотра
Отправка писем по e-mail
Парсинг содержимого тегов с сайта в VBA Excel
Перемещение столбцов и строк с помощью VBA
Поздравление-сюрприз от VBA Excel
Проверка версий офисных программ
Программное создание модуля и процедуры
Программное создание элементов управления
Просмотр содержимого папки в VBA Excel
Простое удаление дубликатов
Работа с буфером обмена в VBA Excel
Расположение формы в окне Excel
Редактирование текста в ячейке из кода VBA
Смена заголовка окна Excel
Смена кодировки UTF-8 на UTF-16
Снятие пароля с проекта VBA Excel
Создание календаря в VBA Excel
Создание квадратной ячейки
Создание оглавления
Создание пользовательского меню
Создание резервной копии файла
Список изменений на листе Excel
Список подключенных библиотек
Сумма прописью для документов
Текст в строке состояния
Удаление всех гиперссылок
Удаление всех пустых строк и столбцов
Удаление пустых строк 1
Удаление пустых строк 2
Удаляющаяся и приближающаяся строка
Форма на весь экран в VBA Excel
Чтение текста из файла с помощью FileSystemObject
Экспорт данных из Excel в PDF

#VBA #ExcelVBA #Sub #Function #Программа #Пример
🗑 Удаление всех пустых строк и столбцов в Excel
Если в вашей таблице накопились пустые строки и столбцы, их можно быстро удалить с помощью макроса VBA. Это поможет избавиться от лишнего пространства и оптимизировать данные.

📌 Код VBA
Sub DeleteEmptyRowsAndColumns()
Dim ws As Worksheet
Dim lastRow As Long, lastCol As Long
Dim i As Long

Set ws = ActiveSheet

Application.ScreenUpdating = False ' Отключаем обновление экрана для ускорения

' Удаление пустых строк (снизу вверх, чтобы не нарушить нумерацию)
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = lastRow To 1 Step -1
If WorksheetFunction.CountA(ws.Rows(i)) = 0 Then
ws.Rows(i).Delete
End If
Next i

' Удаление пустых столбцов (справа налево)
lastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
For i = lastCol To 1 Step -1
If WorksheetFunction.CountA(ws.Columns(i)) = 0 Then
ws.Columns(i).Delete
End If
Next i

Application.ScreenUpdating = True ' Включаем обновление экрана

MsgBox "Все пустые строки и столбцы удалены!", vbInformation, "Готово!"
End Sub


📌 Как работает макрос?
🔹 Проверяет каждую строку и удаляет, если она пустая.
🔹 Затем делает то же самое со столбцами.
🔹 Работает на активном листе.

⚠️ Важно
🔹 Диапазон обработки определяется переменными lastRow и lastCol по первой строке и первому столбцу. На рабочем листе могут оказаться заполненные ячейки вне диапазона по другим строкам и столбцам. Если у вас остались на листе ненужные пустые строки и столбцы, замените 1 в выражениях ws.Cells(Rows.Count, 1) и /или ws.Cells(1, Columns.Count) на нужную цифру.

⚡️ Теперь ваша таблица чистая и аккуратная без пустых строк и столбцов!

#VBA #ExcelVBA #УдалениеСтрок #УдалениеСтолбцов
👍4
📩 Создание и отправка отчетов по электронной почте в Excel
Если вам нужно регулярно отправлять отчеты по e-mail, можно автоматизировать этот процесс с помощью VBA и Outlook. Макрос позволит создать письмо, прикрепить файл и отправить его всего одним кликом! 🚀

📌 Код VBA
Sub SendReportByEmail()
Dim OutApp As Object
Dim OutMail As Object
Dim ReportFile As String

' Указываем путь для сохранения временного PDF-отчета
ReportFile = ThisWorkbook.Path & "\Отчет.pdf"

' Сохраняем текущий лист в PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ReportFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

' Создаем объект Outlook
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = "example@email.com" ' Укажите получателя
.CC = "" ' Копия (если нужно)
.BCC = "" ' Скрытая копия (если нужно)
.Subject = "Автоматический отчет: " & Format(Date, "dd.mm.yyyy")
.Body = "Добрый день!" & vbNewLine & vbNewLine & _
"Во вложении автоматически сгенерированный отчет." & vbNewLine & _
"Если возникнут вопросы, пожалуйста, свяжитесь со мной." & vbNewLine & vbNewLine & _
"С уважением," & vbNewLine & "Ваше имя"
.Attachments.Add ReportFile ' Прикрепляем PDF-файл
.Send ' Отправляем письмо
End With

' Удаляем временный файл
Kill ReportFile

' Очищаем объекты
Set OutMail = Nothing
Set OutApp = Nothing

MsgBox "Отчет успешно отправлен!", vbInformation, "Готово!"
End Sub


📌 Как работает макрос?
🔹 Создает новое письмо в Outlook.
🔹 Добавляет получателя, тему и текст письма.
🔹 Прикрепляет PDF-отчет, сконвертированный из активного листа Excel.
🔹 Автоматически отправляет письмо.
🔹 Outlook может попросить подтвердить отправку (у меня спрашивает).

#VBA #ExcelVBA #Outlook #Отправить #Письмо #Отчет
👍3🔥3
📆 Автоматическое создание календаря в VBA Excel
Если вам нужно создать месячный календарь на листе Excel, можно использовать VBA для генерации таблицы с заголовком, днями недели и датами. 🚀

📌 Код VBA Excel для создания календаря:
Sub CreateCalendar()
Dim ws As Worksheet
Dim startDate As Date, endDate As Date
Dim firstDay As Integer, lastDay As Integer
Dim yearInput As Integer, monthInput As Integer
Dim i As Integer, rowOffset As Integer

' Запрос у пользователя месяца и года
yearInput = InputBox("Введите год:", "Год", Year(Date))
monthInput = InputBox("Введите номер месяца (1-12):", "Месяц", Month(Date))

' Проверка корректности ввода
If monthInput < 1 Or monthInput > 12 Then
MsgBox "Ошибка! Введите месяц от 1 до 12.", vbCritical, "Ошибка ввода"
Exit Sub
End If

' Определяем первый и последний день месяца
startDate = DateSerial(yearInput, monthInput, 1)
lastDay = Day(DateSerial(yearInput, monthInput + 1, 0))

' Создаем новый лист
Set ws = ThisWorkbook.Sheets.Add
ws.Name = Format(startDate, "mmmm yyyy")

' Заголовок
ws.Cells(1, 1).Value = Format(startDate, "mmmm yyyy")
ws.Cells(1, 1).Font.Bold = True
ws.Cells(1, 1).Font.Size = 14
Range("A1:G1").HorizontalAlignment = xlCenterAcrossSelection

' Заголовки дней недели
Dim daysArray As Variant
daysArray = Array("Пн", "Вт", "Ср", "Чт", "Пт", "Сб", "Вс")
For i = 0 To 6
ws.Cells(3, i + 1).Value = daysArray(i)
ws.Cells(3, i + 1).Font.Bold = True
ws.Cells(3, i + 1).HorizontalAlignment = xlCenter
Next i

' Заполнение календаря
firstDay = Weekday(startDate, vbMonday) ' Определяем день недели 1-го числа
rowOffset = 4
i = 1

Do While i <= lastDay
ws.Cells(rowOffset, firstDay).Value = i
ws.Cells(rowOffset, firstDay).HorizontalAlignment = xlCenter
ws.Cells(rowOffset, firstDay).VerticalAlignment = xlCenter
ws.Cells(rowOffset, firstDay).Borders.LineStyle = xlContinuous

' Перемещение к следующему дню
If firstDay = 7 Then
rowOffset = rowOffset + 1
firstDay = 1
Else
firstDay = firstDay + 1
End If
i = i + 1
Loop

' Автоширина столбцов
ws.Columns.AutoFit

MsgBox "Календарь успешно создан!", vbInformation, "Готово!"
End Sub


📌 Как работает макрос?
🔹 Запрашивает у пользователя месяц и год.
🔹 Создает таблицу календаря.
🔹 Заполняет даты и форматирует ячейки.

#VBA #ExcelVBA #Календарь #Calendar
👍2🔥2
🔠 Разделение текста по столбцам
Разделение текста из ячейки по столбцам в VBA Excel с настройкой разделителей.

Если у вас есть данные в одной колонке, разделенные запятыми, пробелами или другими символами, их можно автоматически разделить на отдельные столбцы с помощью VBA. Это особенно полезно для работы с CSV-файлами, списками или импортированными данными. 🚀

📌 Код VBA для преобразования текста в столбцы:
Sub SplitTextToColumns()
Dim ws As Worksheet
Dim rng As Range
Dim delimiter As String

' Выбор активного листа
Set ws = ActiveSheet

' Запрос у пользователя разделителя
delimiter = InputBox("Введите разделитель (например, запятая, точка с запятой, пробел или другой):", "Выбор разделителя", ",")

' Проверка, был ли введен разделитель
If delimiter = "" Then
MsgBox "Ошибка! Вы не ввели разделитель.", vbExclamation, "Ошибка"
Exit Sub
End If

' Выбор диапазона (можно сразу указать нужный диапазон)
On Error Resume Next
Set rng = Application.InputBox("Выберите диапазон с текстом:", "Выбор диапазона", Type:=8)
On Error GoTo 0

If rng Is Nothing Then Exit Sub ' Если пользователь отменил выбор

' Разбиваем текст по столбцам
rng.TextToColumns Destination:=rng.Cells(1, 1), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=True, _
OtherChar:=delimiter

MsgBox "Данные успешно разделены по столбцам!", vbInformation, "Готово!"
End Sub


Этот блок в данный момент никакой функции не исполняет
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _

но с его помощью можно указать разделитель сразу в коде, присвоив нужному элементу значение True.

📌 Как работает макрос?
🔹 Запрашивает у пользователя сначала указать разделитель, потом диапазон ячеек с текстом.
🔹 Разбивает текст в выбранном диапазоне на отдельные столбцы.
🔹 Позволяет использовать любой разделитель (запятая, точка с запятой, пробел и т. д.).

🔥 Теперь данные разделятся на отдельные столбцы, и вам не придется делать это вручную!

#VBA #ExcelVBA #Delimiter #Разделитель #Текст #ПоСтолбцам
🔥3👍1
📃 Как открыть в Excel файл CSV?
В русскоязычном Excel разделителем полей по умолчанию является точка с запятой (;). Файлы CSV с разделителем «;» открываются в Excel в виде таблицы. А файлы с разделителем запятая (,), которых большинство, открываются без разбивки на столбцы (вся строка в одной ячейке).

💡 Как открыть в Excel файл CSV с разделителем — запятая (,)?
🔹 Откройте CSV-файл в любом текстовом редакторе.
🔹 Добавьте сверху пустую строку, вставьте в нее текст sep=, и сохраните.

👍 Теперь файл с разделителем запятая (,) будет открываться в Excel в виде таблицы. Верхняя строка с выражением sep=, отображаться не будет.

#Excel #CSV #Разделитель
👍7
🔄 Оператор With для упрощения работы с объектами
В VBA Excel оператор With позволяет сократить код и упростить работу с объектами, если к ним нужно обращаться несколько раз подряд. Вместо повторяющихся обращений к объекту, With позволяет группировать операции внутри одного блока.

Почему стоит использовать With?
🔹 Уменьшает объем кода – не нужно дублировать имя объекта.
🔹 Ускоряет выполнение – VBA тратит меньше ресурсов на поиск объекта.
🔹 Делает код чище и понятнее.

📌 Пример без With (менее эффективно):
Sub WithoutWith()
Sheets("Лист1").Range("A1").Value = "Заголовок"
Sheets("Лист1").Range("A1").Font.Bold = True
Sheets("Лист1").Range("A1").Font.Size = 14
Sheets("Лист1").Range("A1").Interior.Color = RGB(200, 200, 255)
End Sub


📌 Тот же код с With (более эффективно):
Sub WithExample()
With Sheets("Лист1").Range("A1")
.Value = "Заголовок"
.Font.Bold = True
.Font.Size = 14
.Interior.Color = RGB(200, 200, 255)
End With
End Sub


🛠 Как работает With?
🔹 VBA запоминает объект внутри With и применяет все действия внутри блока к этому объекту.
🔹 Все строки, начинающиеся с . (точки), относятся к объекту внутри With.
🔹 Не забывайте закрывать блок With ... End With, чтобы код работал правильно.

💡 Используйте With, если вам нужно изменить несколько свойств одного объекта – это делает код компактнее, быстрее и удобнее! 🚀

#VBA #ExcelVBA #With #Оптимизация
🔥5👍1
🧾 Как выровнять заголовок в таблице Excel?
Обычно, чтобы выровнять заголовок в таблице на листе Excel, нажимают кнопку «Объединить и поместить в центре». Но объединенные ячейки зачастую не дружат с кодом VBA Excel.

💡 Как выровнять заголовок на листе Excel без объединения ячеек?
🔹 Введите заголовок в левой ячейке диапазона (части строки), по центру которого требуется выравнивание.
🔹 Выделите участок строки, в центре которого должен быть заголовок.
🔹 Откройте окно «Формат ячеек» и перейдите на вкладку «Выравнивание».
🔹 В раскрывающемся списке «по горизонтали» выберите пункт «по центру выделения» и нажмите «OK».

#Excel #Выравнивание #Заголовок
👍1
🔥 Заголовок будет выровнен по центру выделенного диапазона, причем границы ячеек будут скрыты.
💫 Выравнивание заголовка кодом VBA
Выравнивание заголовка таблицы Excel без объединения ячеек с помощью кода VBA:
Sub CenterAlignment()
Range("A1:F1").HorizontalAlignment = xlCenterAcrossSelection
End Sub

🚀 Так даже быстрее, чем вручную!

#VBA #ExcelVBA #Horizontal #Alignment #Выравнивание #Заголовка
👍5
👌 Динамический диапазон для раскрывающегося списка
Как создать динамический диапазон для раскрывающегося списка? Проще всего сделать его с помощью умной таблицы.

Создание динамического диапазона для раскрывающегося списка
🔹 Набор данных для раскрывающегося списка преобразуйте в умную таблицу.
🔹 Выберите ячейку, в которой должен быть создан раскрывающийся список.
🔹 Откройте окно «Проверка вводимых значений» (Данные —> Проверка данных).
🔹 Во вкладке «Параметры» выберите «Тип данных» — «Список».
🔹 В поле «Источник» вставьте формулу =ДВССЫЛ("ИмяТаблицы").

#Excel #Динамический #Диапазон #Раскрывающийся #Список
🔥 При добавлении новых значений в умную таблицу, они автоматически будут добавляться в раскрывающейся список.

👍 Можно все наборы данных для раскрывающихся списков объединить в одну умную таблицу, тогда запись для поля «Источник» будет следующей: =ДВССЫЛ("ИмяТаблицы[ИмяСтолбца]"). 💡 У этого способа есть недостаток: так как разные наборы данных могут иметь разное количество значений, у коротких наборов в общей таблице будут снизу пустые ячейки, которые отобразятся в виде пустых строк в раскрывающихся списках.
👍2
📏 Функция LOF — получение размера файла
В VBA Excel функция LOF (Length Of File) позволяет узнать размер открытого файла в байтах.

📌 Синтаксис:
LOF(FileNumber)
🔹 FileNumber – номер файла, полученный после его открытия с помощью оператора Open.

🔍 Пример получения размера файла
Sub GetFileSize()
Dim fileNum As Integer
Dim fileSize As Long
Dim filePath As String

' Указываем путь к файлу
filePath = "C:\Test\Текстовый документ.txt"

' Открываем файл для чтения
fileNum = FreeFile
Open filePath For Input As fileNum

' Получаем размер файла
fileSize = LOF(fileNum)

' Закрываем файл
Close #fileNum

' Выводим результат
MsgBox "Размер файла: " & fileSize & " байт", vbInformation, "Размер файла"
End Sub


С помощью функции LOF можно из файла с последовательным доступом считать весь текст в переменную.

🔍 Пример записи в переменную всего содержимого файла
Sub ReadFileToVariable()
Dim fileNum As Integer
Dim fileText As Variant
Dim filePath As String

' Указываем путь к файлу
filePath = "C:\Test\Текстовый документ.txt"

' Открываем файл для чтения
fileNum = FreeFile
Open filePath For Input As fileNum
' Записываем в переменную все содержимое файла
fileText = Input(LOF(fileNum), fileNum)
Close fileNum
' Смотрим содержимое переменной
Debug.Print fileText
End Sub


🔄 Сравните результат работы кода, заменив строку fileText = Input(LOF(fileNum), fileNum) на Input #fileNum, fileText (будет считана только первая строка).

#VBA #ExcelVBA #LOF #Open #Input #FreeFile
👍4
🔄 Смена кодировки UTF-8 на UTF-16
Перекодировка текста с UTF-8 на UTF-16 может понадобиться для корректного открытия CSV-файла с кодировкой UTF-8 в приложении Excel.

🛠 Функции для смены кодировки:
'Функция WinApi, использующаяся для смены мультибайтовых кодировок в UTF-16
Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32.dll" (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, ByVal lpMultiByteStr As String, ByVal cchMultiByte As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr) As LongPtr

'Пользовательская функция для смены кодировки с UTF-8 на UTF-16
Function FromUTF8(ByVal sText As String) As String
Dim nRet As Double, strRet As String
strRet = String(Len(sText), vbNullChar)
nRet = MultiByteToWideChar(65001, &H0, sText, Len(sText), StrPtr(strRet), Len(strRet))
FromUTF8 = Left(strRet, nRet)
End Function


Пример смены кодировки у CSV-файла:
Sub Primer()
Dim num1 As Integer, a1 As String, str1 As Variant
'Выбираем файл CSV с кодировкой UTF-8
a1 = Application.GetOpenFilename("Текст с разделителями,*.csv", , "Выбор файла")
If Right(a1, 4) <> ".csv" Then Exit Sub
'Открываем файл и считываем текст в переменную
num1 = FreeFile
Open a1 For Input As num1
str1 = Input(LOF(num1), num1)
Close num1
'Меняем кодировку с UTF-8 на UTF-16
str1 = FromUTF8(str1)
'Меняем, если нужно, разделитель с (,) на (;)
str1 = Replace(str1, ",", ";")
'Записываем перекодированный текст в новый файл CSV
a1 = Replace(a1, ".csv", "-UTF-16.csv")
num1 = FreeFile
Open a1 For Output As num1
Print #num1, str1
Close num1
'Открываем файл для просмотра
ThisWorkbook.FollowHyperlink (a1)
ActiveWindow.ActiveSheet.Columns.AutoFit
End Sub


💡 Пояснения:
🔹 Microsoft Excel не дружит с кодировкой UTF-8 и отображает символы в этой кодировке в виде «кракозябр».
🔹 Excel использует внутреннее представление строк, которое основано на Unicode. Начиная с Excel 2000, это представление — UTF-16LE (Little Endian).
🔹 Если строка на кириллице существует в кодировке UTF-8, Excel может попытаться интерпретировать UTF-8 как ANSI (Windows-1252 или Windows-1251 для кириллицы), что приводит к «кракозябрам».

Текст с картинками на сайте Время не ждёт.

#VBA #ExcelVBA #СменаКодировки #UTF8 #UTF16 #MultiByteToWideChar
👍2
💻 Проверка версий офисных программ
Одна процедура подходит для всех офисных программ, поддерживающих VBA, чтобы определить версию офисной программы.

🛠 Код процедуры:
Sub GetOfficeVersion()
MsgBox Application.Name & " " & Application.version
End Sub


#VBA #Office #Application #Version #Версия
👍2
↩️ Перемещение столбцов и строк в Excel вручную
В Excel можно легко перемещать столбцы и строки без потери данных. Это удобно при реорганизации таблиц!

🛠 Как переместить столбец или строку?
1️⃣ Выделите столбец (кликните по букве) или строку (кликните по номеру).
2️⃣ Наведите курсор на границу выделения, чтобы появился значок перемещения (тонкий крестик со стрелками на концах).
3️⃣ Зажмите Shift и перетащите выделенный диапазон в нужное место.
4️⃣ Отпустите кнопку мыши – данные вставятся без замены! 🚀

✴️ Особенности
🔹 Shift гарантирует, что другие данные не сотрутся.
🔹 Можно перемещать сразу несколько столбцов или строк!

💡 Этот способ работает во всех версиях Excel и позволяет быстро менять структуру таблицы!

#Excel #Перемещение #Строка #Столбец
🔥5
↪️ Перемещение столбцов и строк с помощью VBA
Если нужно автоматически переставить столбцы или строки, используйте VBA!

📌 Перемещение столбца "A" на место столбца "C" со смещением столбца "C" вправо:
Sub MoveColumn()
Columns("A").Cut
Columns("C").Insert Shift:=xlToRight
End Sub


📌 Перемещение строки 2 на место строки 5 со смещением строки 5 вниз:
Sub MoveRow()
Rows(2).Cut
Rows(5).Insert Shift:=xlDown
End Sub


🛠 Как это работает?
🔹 Cut – вырезает данные.
🔹 Insert Shift:=xlToRight – сдвигает столбцы вправо при вставке.
🔹 Insert Shift:=xlDown – сдвигает строки вниз при вставке.

💡 Такой код поможет автоматизировать реорганизацию таблиц и избежать ошибок при ручном перемещении! 🚀

#VBA #ExcelVBA #Перемещение #Столбцов #Строк
👍2