Excel. Трюки и эффекты — страница 19 из 36

Dim lngRow As Long ' Номер текущей строки

Dim intCol As Integer ' Номер текущего столбца

Dim i As Integer

' Открытие импортируемого файла

Open «C:\primer.txt» For Input As #1

' Считываем все строки файла и записываем данные, разделенные _

запятой, в ячейки таблицы (начиная с текущей ячейки)

Do Until EOF(1)

' Считываем строку из файла

Line Input #1, strLine

' Разбираем считанную строку

For i = 1 To Len(strLine)

strCurChar = Mid(strLine, i, 1)

If strCurChar = "," Then

' Найден разделитель столбцов – запятая. Запишем _

сформированное значение в ячейку

ActiveCell.Offset(lngRow, intCol) = strValue

intCol = intCol + 1

strValue = ""

ElseIf i = Len(strLine) Then

' Конец строки – запишем в таблицу последнее _

значение в строке (перед этим дополним его последним _

символом строки, кроме кавычки)

If strCurChar <> Chr(34) Then

strValue = strValue & strCurChar

End If

' Запись в таблицу

ActiveCell.Offset(lngRow, intCol) = strValue

strValue = ""

ElseIf strCurChar <> Chr(34) Then

' Добавление символа в формируемое значение ячейки _

(кавычки игнорируются)

strValue = strValue & strCurChar

End If

Next i

' Переход к новой строке таблицы

intCol = 0

lngRow = lngRow + 1

Loop

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

Close #1

End Sub

После того как данный код написан, в окне выбора макросов появятся макросы ExportAsText и ImportText. В соответствии в кодом макроса экспорт данных будет осуществляться в файл primer.txt, который будет создан на диске С:. Из этого же файла будут импортированы данные при выполнении макроса ImportText.

Перед запуском макроса ExportAsText необходимо выделить диапазон, данные которого следует экспортировать в текстовый файл. Импортируемые данные будут помещены в то место рабочего листа, в котором установлен курсор (при этом ячейка с курсором будет являться левой верхней ячейкой импортированного диапазона).

В текстовом файле столбцы обозначаются символом, (запятая).

Одновременное умножение всех данных диапазона

В данном разделе мы рассмотрим трюк, с помощью которого можно быстро умножить все числа, находящиеся в какой-либо выделенной области, на указанный коэффициент. Для этого нам понадобится макрос, код которого приведен в листинге 3.57.

Листинг 3.57. Умножение данных

Sub MultAllCells()

Dim dblMult As Double

Dim cell As Range

' Ввод коэффициента для умножения

dblMult = InputBox("Введите коэффициент, на который следует

умножать")

' Умножение содержимого на введенный коэффициент

For Each cell In Selection

If IsNumeric(cell.Value) And cell.Value <> "" Then

' Умножаются только ячейки, содержащие числовые данные

cell.Value = cell.Value * dblMult

Else

MsgBox "В ячейке " & cell.Address & « нечисловое значение»

End If

Next

End Sub

Рассмотрим применение данного макроса на конкретном примере.

Допустим, в ячейках Al, В2 и C3 хранятся числовые значения 10, 15 и 20 соответственно. Выделим диапазон, охватывающий эти ячейки, и запустим приведенный выше макрос на выполнение. В результате откроется окно, изображенное на рис. 3.16.

Рис. 3.16. Окно ввода коэффициента


В данном окне с клавиатуры следует ввести коэффициент, на который необходимо умножить все значения выделенной области. Если ввести коэффициент 2, то в ячейках А1, В2 и C3 значения изменятся соответственно на 20, 30 и40.

При выполнении этого трюка не стоит забывать: если в какой-то ячейке выделенного диапазона хранится нечисловое значение, будет выдано соответствующее сообщение.

Преобразование таблицы Excel в HTML-формат

В процессе работы иногда возникает необходимость в быстром преобразовании табличных данных Excel в HTML-код (например, для оперативного размещения на сайте самой свежей информации). Рассмотрим на конкретном примере, каким образом можно решить эту задачу.

Предположим, что нам необходимо преобразовать в HTML-код следующую таблицу (рис. 3.17).

Рис. 3.17. Таблица Excel


В данном случае следует воспользоваться макросом, код которого приведен в листинге 3.58.

Листинг 3.58. Преобразование таблицы в 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

' Если перешли на другую строку, то вставляем

If lngRow <> lngLastRow Then

strOut = strOut & vbTab & «» & vbCrLf & vbTab & _

«» & vbCrLf

' Переход на следующую строку

lngLastRow = lngRow

End If

' Задание шрифта ячейки

If Not IsNull(cell.Font.Size) Then

strStyle = « style=» & "font-size: " & Int(100 * _

cell.Font.Size / 19) & «%;»

End If

' Для полужирного шрифта вставляем

If cell.Font.Bold Then

strCellText = «» & strCellText & «»

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 = ""

' Печать после каждого символа специального _

разделителя –

For i = 1 To Len(strCellText)

strTemp = strTemp & Mid$(strCellText, i, 1) & «
»

Next i

strCellText = strTemp

strStyle = ""

End If

strOut = strOut & vbTab & vbTab & «

strAlign _

& «>» & strCellText & «» & vbCrLf

Next

' Вставка для первой строки и  – для последней

strOut = vbTab & "м & vbCrLf & strOut & vbTab & "м

& vbCrLf

' Вставка дескриптора

strOut = «

» &

vbCrLf & _

strOut & vbCrLf & «

»

' Запускаем Word и показываем в нем сформированный HTML-код

Set objWordApp = CreateObject(«Word.Application»)

objWordApp.documents.Add

objWordApp.Selection = strOut

objWordApp.Selection.Copy

objWordApp.Visible = True

Set objWordApp = Nothing

End Sub

При выполнении данного трюка не стоит забывать, что перед запуском макроса следует выделить диапазон ячеек, который предстоит конвертировать в HTML-код.

В результате применения макроса табличные данные, показанные на рис. 3.17, будут преобразованы в следующий HTML-код:

77345
25851
44415
1725

Читатель, хотя бы немного знакомый с веб-разработками, без труда узнает знакомый стиль HTML-файла. Этот код будет открыт в отдельном окне Microsoft Word, а также скопирован в буфер обмена.

Преобразовать выделенный диапазон в HTML-формат можно и другим способом. Его отличие от приведенного выше заключается в том, что результатом преобразования будет готовый НТМ-файл, сохраненный по указанному пути. Для реализации данного примера нужно воспользоваться макросом, код которого представлен в листинге 3.59.

Листинг 3.59. Экспорт данных в НТМ-файл

Sub ExportAsHtmlFile()

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 strFileName As String ' Имя файла для сохранения HTML-

кода

Dim i As Long

' Запрос у пользователя имени файла для сохранения

strFileName = Application.GetSaveAsFilename( _

InitialFileName:="Primer.htm", _

fileFilter:="HTML Files(*.htm), *.htm")

' Проверка, задал ли пользователь имя файла (если нет, _

то можно выходить)

If strFileName = "" Then Exit Sub

lngLastRow = Selection.Row

' Просмотр всех выделенных ячеек

For Each cell In Selection

' Значение строки для рассматриваемое ячейки

lngRow = cell.Row

' Если перешли на другую строку, то вставляем

If lngRow <> lngLastRow Then

strOut = strOut & vbTab & «» & vbCrLf & vbTab & _

«<