Ru-Board.club
← Вернуться в раздел «Прикладное программирование»

» Excel VBA

Автор: dneprcomp
Дата сообщения: 02.08.2006 03:56
sakhsnake
После всех этих постингов вокруг да около ты уже можешь нормально объяснить и привести примеры ошибок? В чем проявляется неверность данных? Уверен ли, что в первоначальных массивах данные соответствуют желаемому? Как данные попадают в архивы?

Добавлено:
Бери пример со своего 3-го поста. А то я не успеваю за полетом твоей мысли
Автор: sakhsnake
Дата сообщения: 02.08.2006 06:12
dneprcomp

Блин я даже выложил ссылку на файл с обробатываемыми данными и модулем где все и писал.

Про ошибки. В результирующей базе (all_data_db) идет расхождение по количеству. Допустим в db_min одно наименование (допустим: вася пупкин) число одно (допустим: 5), а в all_data_db получается что наименование тоже что и в db_min а количество может быть другим или вообще отсутствовать.
В db_min и db_max данные верно передаются - проверял.

P.S. Скачай архив да посмотри на результаты. Там все наглядно будет видно.
Автор: dneprcomp
Дата сообщения: 02.08.2006 09:04
sakhsnake

Цитата:
я даже выложил ссылку на файл с обробатываемыми данными и модулем где все и писал.
Да, выложил. Без объяснений и в связи с вопросом о форматном поиске. Нам что, догадываться надо? Что ты делаешь с модулем? Как и где происходит его использование? В какой последовательности происходит вызов функций? Ты же не даешь полной информации.
Цитата:
Допустим в db_min одно наименование (допустим: вася пупкин) число одно (допустим: 5), а в all_data_db получается что наименование тоже что и в db_min а количество может быть другим или вообще отсутствовать.

Цитата:
db_min(0,1) - количество товара на точке
db_max(0,1) - количество товара на складе
all_data_db(0,1) - количество товара на точке
all_data_db(0,2) - количество товара на складе
Что с чем не совпадает?
PS. Желательно выдерживать стандарт и в названих функций и переменных не использовать кирилицу. Кирилица читается не везде.
PPS.
Цитата:
' Определение какое число больше kolvo_nal или kolvo_sales
' и занесение наибольшего списка в новый лист
Логику этого пока не понимаю... Плясать надо от большего списка. Больший должен быть складской. Даже если товара на складе нет и даже если товара уже никогда не будет, товар должен быть в складском списке с количеством 0.


Добавлено:

Цитата:
' Условия для корректной работы Sub Создание_списка_товаров()
' В книге должны быть два листа 1-Наличие 2-Движение товаров
' В каждом листе три столбца 1-Название товара 2-Количество 3-Название точки
В тех файлах, что ты поместил в архив данное условие не соблюденно. По крайней мере нет названия точки.
Автор: alin
Дата сообщения: 02.08.2006 11:16
Yuk
Огромное спасибо, скорректировал по Вашей рекомендации, ниже приведенный результат работает:
Private Sub OK_Click()
If CheckBox1.Value And CheckBox2.Value And CheckBox3.Value Or _
CheckBox1.Value = False And CheckBox2.Value = False And CheckBox3.Value = False Or _
CheckBox1.Value And CheckBox2.Value Or _
CheckBox1.Value And CheckBox3.Value Or _
CheckBox2.Value And CheckBox3.Value Then _
MsgBox "Определитесь с операцией!"
If CheckBox1.Value And CheckBox2.Value = False And CheckBox3.Value = False Then
Range("I3").Formula = "=H3-C3"

Unload Me
Else
If CheckBox2.Value And CheckBox1.Value = False And CheckBox3.Value = False Then

Unload Me
Else
If CheckBox3.Value And CheckBox1.Value = False And CheckBox2.Value = False Then

Unload Me
End If
End If
End If
End Sub
Следующий вопрос. Как сделать, чтобы формула заносилась не в ячейку "I3", а в определенную ячейку (активную или отмеченную CheckBox или т.п.).
Автор: Yuk
Дата сообщения: 02.08.2006 14:59
alin

Цитата:
Как сделать, чтобы формула заносилась не в ячейку "I3", а в определенную ячейку (активную или отмеченную CheckBox или т.п.).

У тебя Range("I3") контролирует, в какую ячейку идет запись. Вместо этого может быть любое выражение, возвращающее объект Range:
Selection - выделенная ячейка
Cells(3,9) - ячейка из 3 строки 9 столбца, то же что Range("I3").
Вместо "I3" Может быть переменная типа String, вместо 3 и 9 - переменные типа Long.
Переменную можно взять из формы, например Range(TextBox1.Value).

У тебя все еще бардак с If. Используй конструкцию
Код: If ... Then
...
ElseIf
...
ElseIf
...
Else
...
End If
Автор: alin
Дата сообщения: 02.08.2006 17:23
Yuk
Спасибо!!! Буду пробовать. Хотя с теорией у меня большие проблемы...

Добавлено:
Yuk
Извиняюсь за повтор, но указанный ниже код работает благодаря Вашей поправке:
Private Sub OK_Click()
If CheckBox1.Value And CheckBox2.Value And CheckBox3.Value Or _
CheckBox1.Value = False And CheckBox2.Value = False And CheckBox3.Value = False Or _
CheckBox1.Value And CheckBox2.Value Or _
CheckBox1.Value And CheckBox3.Value Or _
CheckBox2.Value And CheckBox3.Value Then _
MsgBox "Определитесь с операцией!"
If CheckBox1.Value And CheckBox2.Value = False And CheckBox3.Value = False Then
Selection.Formula = "=H3-C3"
Selection.Select
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
Unload Me
Else
If CheckBox2.Value And CheckBox1.Value = False And CheckBox3.Value = False Then
Selection.Formula = "=C3-H3"
Selection.Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Unload Me
Else
If CheckBox3.Value And CheckBox1.Value = False And CheckBox2.Value = False Then
Selection.Formula = "=C3"
Selection.Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Unload Me
End If
End If
End If
End Sub

Это замечание я не понял, если не трудно поясните:

Цитата:
У тебя все еще бардак с If. Используй конструкцию
Код:
If ... Then
...
Else If
...
Else If
...
Else
...
End If

Но главная проблема в том, что я не могу решить свою задачу, которая на первый взгляд показалась мне простой и заключается она в следующем:
в ячейки по порядку заносятся данные по поступлению или отгрузке каких-либо деталей, например,
деталь «A» в ячейки A1, B1, C1…
деталь «B» в ячейки A2, B2, C2 …
деталь «C» в ячейки A3, B3, C3…
………………….до 10-ти деталей.
Необходимо рассчитать в определенный момент, сколько поступило или отгружено деталей «А», «B», «C» и т. д. При этом, если значение не изменилось, то, следовательно, никакие операции не совершались.
Автор: ifaust
Дата сообщения: 04.08.2006 12:03
Как можно создать HTML файл следующим образом:
1. Взять верхние тэги, "шапку" из одного текстового файла
2. Затем добавить таблицу
3. Добавить нижние тэги из другого файла

Какой ещё алгоритм можно использовать?
Автор: unhappy
Дата сообщения: 04.08.2006 14:56
Кто-нибудь знает как программно удалить из книги макросы?
У меня в книге есть пачка листов. Допустим: на каждой есть кнопка с надписью "отправить!" и связанная с процедурой SendMe() находящейся в этом-же листе.
Удалить все кнопки я могу просто сделав

Код: Dim wss As Worksheet
For Each wss In Worksheets
If wss.Shapes.Count > 0 Then wss.Shapes(1).delete
Next
Автор: Yuk
Дата сообщения: 04.08.2006 15:31
unhappy
Плохо искал.
Посмотри здесь:
http://www.cpearson.com/excel/vbe.htm



Добавлено:
alin

Цитата:
Это замечание я не понял, если не трудно поясните

У тебя вот так:
Код: If ... Then
...
Else
If ... Then
...
Else
If ... Then
...
End If
End If
End If
Автор: unhappy
Дата сообщения: 04.08.2006 16:52
Yuk
Спасибо
Каюсь - искал только на русскоязычных. Впредь буду умнее
Автор: alin
Дата сообщения: 06.08.2006 09:35
Yuk
Каждые два часа в ячейки работник заносит данные по поступлению или отгрузке деталей, например:
Деталь "А": (0.00)A1=10, (2.00)B1=20, (4.00)C1=30…(12.00)F1=30, (14.00)G1=20, (16.00)H1=10…
Деталь "В": (0.00)A2=30, (2.00)B2=20, (4.00)C2=10…(14.00)G2=10, (16.00)H2=20, (18.00)I2=30…
Необходимо рассчитать за каждые восемь часов 0.00-8.00, 8.00-16.00, 16.00-24.00 (и за сутки 0.00-24.00) сколько поступило или отгружено тех или иных деталей, причем обратите внимание, что до определенного времени детали накапливались(или отгружались), какое-то время кол-во деталей не изменялось.
Если изменения проводились например в промежутке между 2.00 и 4.00 то приходится заносить на 4.00 два значения например 20/30 (наверное удобнее в этом случае под каждый час отвести две ячейки, хотя теоретически таких изменений может быть и 3) .
Имеется возможность получать данные (=ASSBSERV|assb!'T10', =ASSBSERV|assb!'T11', =ASSBSERV|assb!'T12', …) из другой программы по количеству деталей в данную секунду.
Приветствуются любые предложения и советы по оптимизации этой задачи.
Заранее благодарен!
Автор: Yuk
Дата сообщения: 07.08.2006 07:57
alin
Не до конца понял условие.
Числа, которые вводятся, это количество деталей "на складе" в определенное время? Или сколько поступило/отгружено в данную единицу времени?
Может ли быть несколько строк для одной и той же детали, например, данные за несколько дней?
Можешь дать полный пример с ответами для пары деталей? Как надо показать ответы? В ячейках с динамическим обновлением или,например, при нажатии кнопки пользователем.


Цитата:
Если изменения проводились например в промежутке между 2.00 и 4.00 то приходится заносить на 4.00 два значения например 20/30 (наверное удобнее в этом случае под каждый час отвести две ячейки, хотя теоретически таких изменений может быть и 3) .

В принципе можно изменить структуру таблицы. 3 столбца: Деталь-Время-Число.
Автор: ifaust
Дата сообщения: 07.08.2006 11:54
спсб за ссылочку. в англоязычных материалах ещё не рылся.


Цитата:
HTML конвертеров уже куча написано. Причем код обычно открыт и модифицировать его не так сложно.
Пример: http://www.mvps.org/dmcritchie/excel/xl2html.htm


Вот интересная и простая идейка нашлась:
A simple .BAT file to copy 3 files into one output.
c:
cd c:\temp\billsweb
copy part1.html +passlist.html +part3.html composite.html

внутри ВБА кода прописать:
'push.bat merges 3 files: part1.html +passlist.html +part2.html into Composite.html
Shell "c:\temp\billsweb\push.bat"

Есть ли возможность сделать ещё проще и запустить слияние 3-х файлов прямо из Эксэля, не запуская батовский файл?


Добавлено:
как прописать такое условие:
если в ячейки цифровые, процентные данные
и если выше нуля, то цвет в HTML збрасывается зелёный,
а если меньше нуля, то красный

возможно получится использование примера ниже по аналогии:

If cell.Font.Bold Then
strCellText = "<b>" & strCellText & "</b>"
End If

Добавлено:
или как извлечь цвет шрифта ячейки и окрасить им соответствующую яцейку в HTML файле.
Автор: Yuk
Дата сообщения: 07.08.2006 19:24
ifaust

Цитата:
Есть ли возможность сделать ещё проще и запустить слияние 3-х файлов прямо из Эксэля, не запуская батовский файл?

Можно в Shell прописать непосредственно команду copy, с полными путями, естественно. Именя файлов можно подставлять через переменные. Например,
Код: Shell "copy " & path1 & file1 & "+" & path2 & ...
Автор: SERGE_BLIZNUK
Дата сообщения: 08.08.2006 12:45
вопрос задал в Excel FAQ (часть 2) - [29]
поэтому здесь его переформулирую ;-))))

есть большой XLS файл (более 80 колонок и 15 тыс.записей) в котором не работает фильтрация данных.

подскажите, плиз, можно ли написать такой макрос,
чтобы в Excel были видны (и доступны для изменения) только записи (строки) отвечающие определённому условию?...
Автор: ifaust
Дата сообщения: 08.08.2006 12:45
Вот собрал такой код:
1. В ячейке B35 нужно указать путь к выходному файлу
2. Выделеть облась экспорта
Но в итогу цвет и жирность экспортированны не будут Why?
через Shell надо как-то вызвать командную строку и отправить туда команду слияния.


[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

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


' Так можно покрасить web ячейки в зависимости от значения
If IsNumeric(cell.Value) And Not IsEmpty(cell) Then

If cell.Value > 0 Then
strCellText = "<font color=#008000>" & strCellText & "</font>"
'cell.Interior.Color = RGB(0, 255, 0) ' в зеленый

ElseIf cell.Value < 0 Then
strCellText = "<font color=#FF0000>" & strCellText & "</font>"
'cell.Interior.Color = RGB(255, 0, 0) ' в красный

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

' Задание выравнивания
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

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 class=styles>" _
& vbCrLf & strOut & vbCrLf & "</table>"

' Сохранение HTML-кода в файл
dirname = ActiveSheet.Cells(35, 2).Value
name = dirname + "\webreport" + ".html"
Open name For Output As 1
Print #1, strOut
Close 1

'Shell "copy " & path1 & file1 & "+" & path2 & ...
Shell "copy " & dirname + "\top" + ".html" & "+" _
& dirname + "\webreport" + ".html" & "+" _
& dirname + "\bottom" + ".html" & " ireport.html"

'Shell "copy " & dirname & Top.HTML & "+" _
& dirname & webreport.HTML

' Вывод окна с информационным сообщением о результатах работы
MsgBox Selection.Count & " ячеек экспортировано в файл " & _
strFileName
End Sub
[/more]
Автор: alin
Дата сообщения: 08.08.2006 18:19
Yuk
Скинул пример с описанием.
_http://rapidshare.de/files/28647483/R_List.rar.html (22Kb)
Пароль: ru-board
Автор: Yuk
Дата сообщения: 08.08.2006 22:17
alin
Написал 2 пользовательские функции для расчета, сколько поступило (DetailsIn) и сколько отгрузили (DetailsOut).
[more=Код]Function DetailsIn(rng As Range) As Variant
Application.Volatile

Dim c As Range
Dim lastc As Variant

If rng.Rows.Count > 1 Then
DetailsIn = CVErr(xlErrValue)
Exit Function
End If
For Each c In rng
If c.Address = rng.Cells(1, 1).Address Then
If Not IsNumeric(c.Value) Or IsEmpty(c) Then
DetailsIn = CVErr(xlErrValue)
Exit Function
Else
lastc = c.Value
End If
ElseIf IsNumeric(c.Value) And Not IsEmpty(c) Then
If c.Value - lastc > 0 Then
DetailsIn = c.Value - lastc + DetailsIn
End If
lastc = c.Value
End If
Next
If DetailsIn = 0 Then DetailsIn = "-"
End Function

Function DetailsOut(rng As Range) As Variant
Application.Volatile

Dim c As Range
Dim lastc As Variant

If rng.Rows.Count > 1 Then
DetailsOut = CVErr(xlErrValue)
Exit Function
End If
For Each c In rng
If c.Address = rng.Cells(1, 1).Address Then
If Not IsNumeric(c.Value) Or IsEmpty(c) Then
DetailsOut = CVErr(xlErrValue)
Exit Function
Else
lastc = c.Value
End If
ElseIf IsNumeric(c.Value) And Not IsEmpty(c) Then
If c.Value - lastc < 0 Then
DetailsOut = lastc - c.Value + DetailsOut
End If
lastc = c.Value
End If
Next
If DetailsOut = 0 Then DetailsOut = "-"
End Function
[/more]
Сделай новый модуль и вставь этот код туда.
В таблице 1 для 0:00-8:00 пишешь =DetailsIn(B2:J2), и т.д.
В таблице 2 то же, но =DetailsOut(B2:J2) и т.д.

Что должны делать твои кнопки я не понял.


Добавлено:
SERGE_BLIZNUK
Используй AdvancedFilter.
Поищи в Excel FAQ топике по слову Filter. Я там постил код несколько раз.


Добавлено:
ifaust
Во-первых, для длинного кода используй тег more (см. мой предыдущий пост - редактировать).


Цитата:
' Чтение текста в ячейке
strCellText = cell.Text

Вот здесь ты теряешь цвет и жирность.

Автор: SERGE_BLIZNUK
Дата сообщения: 08.08.2006 23:12
Yuk

Цитата:
Используй AdvancedFilter


Цитата:
читай хелп про расширенный фильтр.


спасибо за ответ! я уже понял, что расширенный фильтр и есть решение моей проблемы!
Автор: ifaust
Дата сообщения: 09.08.2006 09:20
ок, получилось. перносим эту строку выше. в предыдущем посте код исправил.
продолжая оттачивать код, возникли следующие вопросы:
1. что нужно прописать, чтобы окрашивались не просто цифровые ячейки, а только процентные? наверное, что-то здесь исправить:
If IsNumeric(cell.Value) And Not IsEmpty(cell) Then

2. не удаётся слить три файла из програмного кода VBA, и даже просто запустить батовский файл. перепробывал следующие варианты, но не один не проходит

' Сохранение HTML-кода в файл
dirname = ActiveSheet.Cells(35, 2).Value
name = dirname + "\webreport" + ".html"
Open name For Output As 1
Print #1, strOut
Close 1

'Shell "copy " & path1 & file1 & "+" & path2 & ...
Shell "copy " & dirname + "\top" + ".html" & "+" _
& dirname + "\webreport" + ".html" & "+" _
& dirname + "\bottom" + ".html" & " ireport.html"

'Shell "copy " & dirname & Top.HTML & "+" _
& dirname & webreport.HTML

Shell dirname + "\merge.bat"
Shell "cmd.exe C:\merge.bat"
Автор: SERGE_BLIZNUK
Дата сообщения: 09.08.2006 12:24

Цитата:
что нужно прописать, чтобы окрашивались не просто цифровые ячейки, а только процентные? наверное, что-то здесь исправить:
If IsNumeric(cell.Value) And Not IsEmpty(cell) Then

а попробуйте так:
if cell.NumberFormat = "0.00%" Then ...
Автор: Yuk
Дата сообщения: 09.08.2006 17:44
ifaust

Цитата:
а попробуйте так:
if cell.NumberFormat = "0.00%" Then ...

Или так:
If InStr(1, cell.NumberFormat, "%", 1) > 0 Then
Автор: ifaust
Дата сообщения: 09.08.2006 17:49
Ещё одна идейка, только не помню, как узнать, если число делится без остатка. Вообщем
если номер строки чётный/нечётный, то фон ячейки окрашивается в определённый цвет. В HTML это выглядет так:
<p><span style="background-color: #FFCC99">hello world</span></p>
Автор: Yuk
Дата сообщения: 09.08.2006 17:53
ifaust

Цитата:
не удаётся слить три файла из програмного кода VBA

У меня получилось так:
Shell "cmd /c copy C:\TEMP\file1.txt+C:\TEMP\file2.txt+C:\TEMP\file3.txt C:\TEMP\fileall.txt"

У тебя пробелов в названиях файлов/директорий нет?



Добавлено:

Цитата:
как узнать, если число делится без остатка

If cell.Row Mod 2 = 0 Then
Автор: ifaust
Дата сообщения: 10.08.2006 16:34
Прописал, но все, даже отрицательные процентные результаты, окрашиваются в зелёный цвет.

' Так можно покрасить ячейки в зависимости от значения
If IsNumeric(cell.Value) And Not IsEmpty(cell) Then

' в зеленый
If InStr(1, cell.NumberFormat, "%", 1) > 0 Then
strCellText = "<font color=#008000>" & strCellText & "</font>"

' в красный
ElseIf InStr(1, cell.NumberFormat, "%", 1) < 0 Then
strCellText = "<font color=#FF0000>" & strCellText & "</font>"

End If
End If
Автор: Yuk
Дата сообщения: 10.08.2006 17:22
ifaust
Ты хоть посмотрел описание функции InStr? Она возвращает позицию 1-го найденного символа в строке, в нашем случае "%". Если не найдено, возвращает 0. То есть код If InStr(1, cell.NumberFormat, "%", 1) > 0 Then определяет, ячейка отформатирована как процент или нет. <0 здесь вообще не имеет смысла. Ты хотел проценты? Добавь это условие в свой предыдущий код.
Ну почему все надо разжевать и в рот положить?
Автор: ifaust
Дата сообщения: 10.08.2006 17:54
Признаюсь, функция наворочена для меня, чтобы так с ходу в англоязычном хэлпе понять что к чему

Следующий релиз кода:
инструкция по пременению:
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, надо его выделять. отсюда вытекает вопрос... спсб.
Автор: Yuk
Дата сообщения: 10.08.2006 19:15
ifaust
Извиняюсь, что не сдержался. А что в русском экселе VBA хелп на аглийском? Или это английский эксел?


Цитата:
1. можно ли с помощию Excel подключиться к серверу по FTP и закачать готовую страничку, график автоматически? если да, скиньте ссылки на источники, исходники.

http://www.bygsoftware.com/Excel/VBA/ftp.htm
Принцип тот же, что ты используешь для объединения файлов, то есть через Shell. Если имя файла не меняется, можно не городить огород, а создать батник заранее.
Ключевой момент:
Код: ftp -s:file.txt
Автор: SERGE_BLIZNUK
Дата сообщения: 11.08.2006 05:40

Цитата:
Извиняюсь, что не сдержался.
извиняюсь за оффтоп - это вы по поводу
If InStr(..) > 0 Then
ElseIf InStr( ) < 0 Then ? Стыдно признаться, но я сам ржал и еле сдержался, чтобы не кинуться объяснять...



Цитата:
А что в русском экселе VBA хелп на аглийском

Да. включая русский Excel 2003/ И насколько я помню - русского никогда не было. Они (разработчики, локализаторы и прочие микрософтовцы) считают (и возможно справедливо), что обычные пользователи не лезут в редактор макросов, а если залезли - будьте добры, читайте на английском..

ну и ещё прооффтоплю.
только что на натахаус опубликовали книжку: Использование макросов в Excel
Автор: С. Роман
Издательство: СПб.: Питер
Год: 2004
Страниц: 507 с.: ил.
Формат: DJVU
Размер: 8.27 MB
ISBN: 5-94723-584-6
[more]От издателя
Несмотря на мощные функциональные возможности, обеспечиваемые пользовательским интерфейсом Excel, существует ряд задач, выполнение которых возможно только программным путем. Книга "Использование макросов в Excel" представляет собой введение в программирование на Excel VBA, содержащее примеры решения различных практических задач, возникающих при работе в Excel.

Материал книги рассчитан на пользователей Excel, а также программистов, которые не знакомы с объектной моделью Excel. Наряду с разделами,посвященными разработке макросов для Excel 2002, здесь излагается вводный курс по написанию макросов и программ в среде Excel.
спасибо Андрей ака AndiGo
http://rapidshare.de/files/28949396/001113.rar.html
[/more]
Автор: alin
Дата сообщения: 12.08.2006 00:16
Yuk
Огромное спасибо за Код!!!

Цитата:
Что должны делать твои кнопки я не понял.

Да, с таким кодом теперь и я не знаю, что с ними делать...
Низкий поклон за поддержку!

Страницы: 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768

Предыдущая тема: Стоит ли переходить с Билдера на Делфи?


Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.