Готовые макросы в VBA Excel, Миронов. Готовые макросы в vba excel, Миронов Глава Макросы 9
 Скачать 1.35 Mb.
|
Преобразование таблицы Excel в HTML-форматЛистинг 3.60. Преобразование таблицы в HTML-формат Sub ExportAsHtml() Dim strStyle As String ' Параметры стиля отображения ячейки Dim strAlign As String ' Параметры выравнивания ячейки Dim strOut As String ' Выходная строка с HTML-кодом Dim cell As Object ' Обрабатываемая ячейка Dim strCellText As String ' Текст обрабатываемой ячейки Dim lngRow As Long ' Номер строки обрабатываемой ячейки Dim lngLastRow As Long ' Номер строки предыдущей ячейки Dim strTemp As String Dim objWordApp As Object Dim i As Long lngLastRow = Selection.Row ' Просмотр всех выделенных ячеек For Each cell In Selection ' Значение строки для рассматриваемой ячейки lngRow = cell.Row ' Если перешли на другую строку, то вставляем | |
' Запускаем Word и показываем в нем сформированный HTML-код
Set objWordApp = CreateObject("Word.Application")
objWordApp.documents.Add
objWordApp.Selection = strOut
objWordApp.Selection.Copy
objWordApp.Visible = True
Set objWordApp = Nothing
End Sub
Генератор случайных чисел
Листинг__2.77.'>Листинг 2.77. Функция dhGetRandomValues
Function dhGetRandomValues() As Variant
Dim intRow As Integer ' Номер текущей строки
Dim intCol As Integer ' Номер текущего столбца
Dim aintOut() As Integer ' Выходной массив (двумерный)
Dim aintValues() As Integer ' Массив с возможными значениями
Dim intMax As Integer ' Последний доступный элемент массива _
aintValues
Dim i As Integer
ReDim aintOut(1 To Application.Caller.Rows.Count, 1 To _
Application.Caller.Columns.Count)
' Всего нужно чисел...
intMax = Application.Caller.Rows.Count * _
Application.Caller.Columns.Count
ReDim aintValues(1 To intMax)
' Заполнение массива aintValues значениями от 1 до intMax
For i = 1 To intMax
aintValues(i) = i
Next i
' Занесение значений в выходной массив aintOut, в произвольном _
порядке выбирая их из aintValues
Randomize
For intRow = 1 To Application.Caller.Rows.Count
For intCol = 1 To Application.Caller.Columns.Count
' Определение номера элемента из aintValues
i = Rnd * intMax
If i = 0 Then i = 1
' Занесение этого элемента в выходной массив
aintOut(intRow, intCol) = aintValues(i)
' Уменьшение массива aintValues (то есть еще один его _
элемент выбран) - замена выбранного элемента последним _
в массиве
aintValues(i) = aintValues(intMax)
intMax = intMax - 1
Next intCol
Next intRow
' Возвращение массива значений
dhGetRandomValues = aintOut
End Function
Случайные числа — на основании диапазона
Листинг 2.78. Функция dhGetRandomValues1
Function dhGetRandomValues1(rgSource As Range) As Variant
Dim intRow As Integer ' Номер текущей строки
Dim intCol As Integer ' Номер текущего столбца
Dim avarOut() As Variant ' Выходной массив (двумерный)
Dim avarValues() As Variant ' Массив с возможными значениями
Dim intValCount As Integer ' Количество возможных значений
Dim cell As Range
Dim i As Integer
ReDim avarOut(1 To Application.Caller.Rows.Count, 1 To _
Application.Caller.Columns.Count)
' Всего нужно чисел...
intValCount = rgSource.Rows.Count * rgSource.Columns.Count
ReDim avarValues(1 To intValCount)
' Заполнение массива avarValues значениями из указанного _
диапазона
For Each cell In rgSource
i = i + 1
avarValues(i) = cell.Value
Next cell
' Занесение значений в выходной массив avarOut, в произвольном _
порядке выбирая их из avarValues
Randomize
For intRow = 1 To Application.Caller.Rows.Count
For intCol = 1 To Application.Caller.Columns.Count
' Определение номера элемента из avarValues
i = Rnd * intValCount
If i = 0 Then i = 1
' Занесение этого элемента в выходной массив
avarOut(intRow, intCol) = avarValues(i)
Next intCol
Next intRow
' Возвращение массива значений
dhGetRandomValues1 = avarOut
End Function