Признаюсь, функция наворочена для меня, чтобы так с ходу в англоязычном хэлпе понять что к чему
Следующий релиз кода:
инструкция по пременению:
1. пишем в ячейке B35 путь рабочей папки
2. кидаем туда файлы top.html и bottom.html с началом и концом кода сайта соответственно
3. в данном случае будет экспортирован диапазон "B1:E31". исправляем если нужно
4. выделяем диаграмму для экспорта. если её нет, то и не надо.
[more]
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 name As String, dirname As String
Dim i As Long
' Определение папки
dirname = ActiveSheet.Cells(35, 2).Value
name = dirname + "\webreport" + ".html"
' Сохранение графика
If ActiveChart Is Nothing Then
' Нет выделенных диаграмм
MsgBox "Выделите диаграмму"
Else
' Сохранение...
ActiveChart.Export dirname & "\tchart.gif", "GIF"
End If
ActiveSheet.Range("B1:E31").Select
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
' Чтение текста в ячейке
strCellText = cell.Text
' Так можно покрасить ячейки в зависимости от значения
If IsNumeric(cell.Value) And Not IsEmpty(cell) _
And InStr(1, cell.NumberFormat, "%", 1) > 0 Then
' в зеленый
If cell.Value > 0 Then
strCellText = "<font color=#008000>" & strCellText & "</font>"
' в красный
ElseIf cell.Value < 0 Then
strCellText = "<font color=#FF0000>" & strCellText & "</font>"
End If
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
' Для наклонного шрифта вставляем <em>
If cell.Font.Italic Then
strCellText = "<em>" & strCellText & "</em>"
End If
' Задание фона ячейки
'If cell.Row Mod 2 = 0 Then
' strCellText = "<bgcolor=#FFCC99>" & strCellText & "</font>"
'End If
' Задание выравнивания
If cell.HorizontalAlignment = xlRight Then
' По правому краю
strAlign = " align=" & "right"
ElseIf cell.HorizontalAlignment = xlCenter Then
' По центру
strAlign = " align=" & "center"
Else
' По левому краю (по умолчанию)
strAlign = ""
End If
' Если нужно, то вертикальный вывод текста (в строку 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
If cell.Row Mod 2 = 0 Then
strOut = strOut & vbTab & vbTab & "<td bgcolor=#FFE4CA" & strStyle & _
strAlign & ">" & strCellText & "</td>" & vbCrLf
Else
strOut = strOut & vbTab & vbTab & "<td" & strStyle & _
strAlign & ">" & strCellText & "</td>" & vbCrLf
End If
Next
' Вставка <tr> для первой строки и </tr> - для последней
strOut = vbTab & "<tr>" & vbCrLf & strOut & vbTab & "</tr>" & vbCrLf
' Вставка дескриптора <table>
strOut = "<table border=0 cellpadding=4 cellspacing=0 class=styles>" _
& vbCrLf & strOut & vbCrLf & "</table>"
' Сохранение HTML-кода в файл
Open name For Output As 1
Print #1, strOut
Close 1
' Склеивание странички
Shell "cmd /c copy " & dirname & "\top.txt+" & dirname & _
"\webreport.html+" & dirname & "\bottom.txt " & dirname & "\index.html"
'Shell dirname + "\merge.bat"
' Вывод окна с информационным сообщением о результатах работы
MsgBox Selection.Count & " ячеек экспортировано в файл " & _
strFileName
End Sub
[/more]
В целях дальнеёшего усовершенствования кода, следующие вопросики:
1. можно ли с помощию Excel подключиться к серверу по FTP и закачать готовую страничку, график автоматически? если да, скиньте ссылки на источники, исходники.
2. график определяется как "Диагр.3". но автоматически, этот объект не экспортируется в gif, надо его выделять. отсюда вытекает вопрос... спсб.