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

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

Option Compare Binary
 
Function FirstProperCaseWord(ByVal txt$) As String
    ' возвращает первое слово, написанное с заглавной буквы в строке txt$

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