Таксономические единицы (категории) растений: Каждая система классификации состоит из определённых соподчиненных друг другу...
Историки об Елизавете Петровне: Елизавета попала между двумя встречными культурными течениями, воспитывалась среди новых европейских веяний и преданий...
Топ:
Когда производится ограждение поезда, остановившегося на перегоне: Во всех случаях немедленно должно быть ограждено место препятствия для движения поездов на смежном пути двухпутного...
Оценка эффективности инструментов коммуникационной политики: Внешние коммуникации - обмен информацией между организацией и её внешней средой...
Методика измерений сопротивления растеканию тока анодного заземления: Анодный заземлитель (анод) – проводник, погруженный в электролитическую среду (грунт, раствор электролита) и подключенный к положительному...
Интересное:
Уполаживание и террасирование склонов: Если глубина оврага более 5 м необходимо устройство берм. Варианты использования оврагов для градостроительных целей...
Средства для ингаляционного наркоза: Наркоз наступает в результате вдыхания (ингаляции) средств, которое осуществляют или с помощью маски...
Подходы к решению темы фильма: Существует три основных типа исторического фильма, имеющих между собой много общего...
Дисциплины:
2021-10-05 | 39 |
5.00
из
|
Заказать работу |
|
|
Листинг 2.73. Функция dhSheetOffset
Function dhSheetOffset(offset As Integer, cell As Range) As Variant
' Возврат корректного значения ячейки cell листа, смещение _
которого относительно текущего задано переменной offset
dhSheetOffset = Sheets(Application.Caller.Parent.Index _
+ offset).Range(cell.Address)
End Function
Листинг 2.74. Функция dhSheetOffset2
Function dhSheetOffset2(offset As Integer, cell As Range) As Variant
' Корректировка смещения (чтобы ссылка была на рабочий лист)
Do While TypeName(Sheets(cell.Parent.Index + offset)) _
<> "Worksheet"
If offset > 0 Then
' Пропускаем лист и проходим вперед по книге
offset = offset + 1
Else
' Пропускаем лист и проходим назад по книге
offset = offset - 1
End If
Loop
' Возврат корректного значения ячейки cell листа, смещение _
которого относительно текущего задано переменной offset _
с пропуском листов с диаграммами
dhSheetOffset2 = Sheets(cell.Parent.Index _
+ offset).Range(cell.Address)
End Function
Преобразование таблицы 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
' Если перешли на другую строку, то вставляем <tr>
If lngRow <> lngLastRow Then
strOut = strOut & vbTab & "</tr>" & vbCrLf & vbTab & _
"<tr>" & vbCrLf
' Переход на следующую строку
lngLastRow = lngRow
End If
' Задание шрифта ячейки
If Not IsNull(cell.Font.Size) Then
strStyle = " style=" & "font-size: " & Int(100 * _
|
cell.Font.Size / 19) & "%;"
End If
' Для полужирного шрифта вставляем <b>
If cell.Font.Bold Then
strCellText = "<b>" & strCellText & "</b>"
End If
' Задание выравнивания
If cell.HorizontalAlignment = xlRight Then
' По правому краю
strAlign = " align=" & "right"
ElseIf cell.HorizontalAlignment = xlCenter Then
' По центру
strAlign = " align=" & "center"
Else
' По левому краю (по умолчанию)
strAlign = ""
End If
' Чтение текста в ячейке
strCellText = cell.Text
' Если нужно, то вертикальный вывод текста (в строку strTemp _
с последующим перенесением обратно в strCellText)
If cell.Orientation <> xlHorizontal Then
strTemp = ""
' Печать после каждого символа специального _
разделителя - <br>
For i = 1 To Len(strCellText)
strTemp = strTemp & Mid$(strCellText, i, 1) & "<br>"
Next i
strCellText = strTemp
strStyle = ""
End If
strOut = strOut & vbTab & vbTab & "<td" & strStyle & strAlign _
& ">" & strCellText & "</td>" & vbCrLf
Next
' Вставка <tr> для первой строки и </tr> - для последней
strOut = vbTab & "<tr>" & vbCrLf & strOut & vbTab & "</tr>" & vbCrLf
' Вставка дескриптора <table>
strOut = "<table border=1 cellpadding=3 cellspacing=1>" & vbCrLf & _
strOut & vbCrLf & "</table>"
' Запускаем 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. Функция 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
|
|
Своеобразие русской архитектуры: Основной материал – дерево – быстрота постройки, но недолговечность и необходимость деления...
Индивидуальные и групповые автопоилки: для животных. Схемы и конструкции...
Особенности сооружения опор в сложных условиях: Сооружение ВЛ в районах с суровыми климатическими и тяжелыми геологическими условиями...
История создания датчика движения: Первый прибор для обнаружения движения был изобретен немецким физиком Генрихом Герцем...
© cyberpedia.su 2017-2024 - Не является автором материалов. Исключительное право сохранено за автором текста.
Если вы не хотите, чтобы данный материал был у нас на сайте, перейдите по ссылке: Нарушение авторских прав. Мы поможем в написании вашей работы!