Главная » Макросы VBA Excel

Макросы VBA Excel — Страница 30

Сохранение информации в пользовательских свойствах книги Excel

 

Sub SDoc(ByRef WB As Workbook, ByVal VarName As String, ByVal VarValue As Variant)
Sub DDoc(ByRef WB As Workbook, ByVal VarName As String)
Sub DDocALL(ByRef WB As Workbook)
Function GDoc(ByRef WB As Workbook, ByVal VarName As String) As String
Function GDocB(ByRef WB As Workbook, ByVal VarName As String) As Boolean
 
Sub ПримерИспользованияПользовательскихСвойствКнигиExcel()
    DDocALL ActiveWorkbook    ' удаляем все ранее назначенные пользовательские свойства
    ' и записываем новые:
    SDoc ActiveWorkbook, "ICQ", "58-36-318"
    SDoc ActiveWorkbook, "Skype", "ExcelVBA.ru"
    SDoc ActiveWorkbook, "Сайт", "http://ExcelVBA.ru/"
 
    ' теперь можно закрыть файл, предварительно его сохранив
    ' а потом, после очередного открытия, считать сохранённые свойства:

    txt = GDoc(ActiveWorkbook, "ICQ") & vbNewLine & GDoc(ActiveWorkbook, "Сайт")
    MsgBox txt, vbInformation, "Пользовательские свойства книги Excel"
    ' и удалить ненужные
    DDoc ActiveWorkbook, "ICQ"
End Sub

Прозрачная форма в VBA (регулировка прозрачности формы)

В данной статье собрано несколько примеров установки прозрачности форм (UserForm)

Макрос для создания списка случайных адресов email

Макрос выводит на активный лист (в первый столбец) случайные email

Я использовал этот макрос для тестирования программы рассылки писем.

Sub GenerateEmails()
    On Error Resume Next: Err.Clear
    Dim ra As Range: Set ra = Range([A2], Range("A" & Rows.Count).End(IIf(Len(Range("A" & Rows.Count)), xlDown, xlUp)))
    Dim cell As Range
    txt = "abcdefghijklmnopqrstuvwxyz_1234567890"
    For Each cell In ra.Cells
        n = n + 1: dom$ = Choose(n Mod 3 + 1, "@mail.ru", "@yandex.ru", "@gmail.com")
        Randomize: Nam$ = ""
        For i = 1 To Rnd(n) * 5 + 4
            Nam$ = Nam$ & Mid(txt, Fix(Rnd(i) * Len(txt) + 1), 1)
        Next
        cell = Nam$ & dom$
    Next cell
End Sub

Функция НОД (наибольший общий делитель) на VBA

Ниже представлен аналог встроенной в Excel 2007 функции НОД (наибольший общий делитель), реализованный средствами VBA в Excel

В прикреплённом файле обратите внимание на формулы в синих и зелёных ячейках - как видите, результаты работы функций (встроенной, и пользовательской) полностью совпадают.

Использовать VBA-аналог функции НОД можно по-разному - как задавая в качестве параметра непрерывный диапазон ячеек, так и перечисляя значения (или ссылки на ячейки) через точку с запятой:

=NOD(A3:B4;B5:C6;B8)
=NOD(A4;B4;72)
=NOD(8;12;2;;6)
=NOD(A6:B7;B9:C10)
=NOD(A8:D8)
=NOD(A9;B11:C13)
=NOD(A9:B10;B11:C12;B14)
=NOD(B6;A6;B10;D10)

Внимание! Функция НОД появилась только в Excel 2007 - поэтому при открытии примера в Excel 2003 (и более ранних версиях) будет работать только пользовательская функция, а встроенная выдаст ошибку #ИМЯ!

Замена кодов символов Unicode на сами символы

Функция позволяет произвести замену в текстовой строке кодов символов Unicode на их значения

 

В функции используются регулярные выражения (RegExp)

Пример использования функции ReplaceUnicodeChars:

Sub ЗаменаКодовСимволовВСтроке()
    ' исходная текстовая строка, содержащая коды символов Unicode
    txt$ = "Санаторий\u2013профилакторий \u201dЛесная сказка\u201d приглашает Вас!"
 
    res$ = ReplaceUnicodeChars(txt)    ' заменяем коды на симолы

    Debug.Print res$    ' выводит: Санаторий–профилакторий ”Лесная сказка” приглашает Вас!
End Sub