» Excel VBA

virginijus
Формула в условном форматировании:

Код: =OR(A$1="Сб",A$1="Вс")

Yuk
Код:=OR(A$1="Сб",A$1="Вс")
Применить на все ячейки.

Не понял, от чего ячеика должна покраснеть?

Добавлено:
Макросы в excell книга C. Роман, кому надо, изучаите:
http://rapidshare.de/files/34597806/Macros_Excel_VBA.djvu.html

Добавлено:
Ну вроде разобрался:

Sub Tusuoti_Click()
Dim S As String
Dim S1 As String
Dim I
Dim Z
S = "Sekmadienis"
S1 = "Ðeðtadienis"
Range("F17:aj108").Select
With Selection.Interior
.ColorIndex = 0
End With
For I = 0 To 30
Range("F15").Select
If Selection.Offset(0, I) = S Or Selection.Offset(0, I) = S1 Then
Selection.Offset(1, I).Select
For Z = 0 To 91
Selection.Offset(1, 0).Select
With Selection.Interior
.ColorIndex = 15
End With
Next Z
End If
Next I
End Sub

virginijus

Цитата:

Не понял, от чего ячеика должна покраснеть?

См. Формат - Условный формат в меню

Спасибо Yuk

Yuk, привет. это снова я. У меня таки получилось с Image'ами, что рисунки вставляются в соответсвии с ячейками и именами файлов. Теперь возник вопрос такого характера: как определить на какой Image был сделан клик и вывести его на отдельную форму? Спасибо.

Добавлено:
PS: Как назначить Иконку курсору при наведении на Image. Пробовал в свойствах MouseIcon, выбирал нужный мне курсор, а он ноль эмоций, как будто и не назначал. Вот такая беда еще есть

При вставке рисунков, связывать их с макросом, типа "Рисунок1_Щёлкнуть", а в макросе реализовать открытие формы и вставку выделенного рисунка на неё.

PavelO

Цитата:

Как назначить Иконку курсору при наведении на Image. Пробовал в свойствах MouseIcon, выбирал нужный мне курсор, а он ноль эмоций

.MousePointer = 99 не забыл?


Цитата:

как определить на какой Image был сделан клик

Цитата:

При вставке рисунков, связывать их с макросом, типа "Рисунок1_Щёлкнуть", а в макросе реализовать открытие формы и вставку выделенного рисунка на неё.

Это правильно, но не будешь же описывать событие для объектов, которые вставляются динамически. Делается это через класс. Описывается новый класс, где прописывается реакция на события для всех объектов этого класса. Короче, проще показать.

Создаем новый модуль класса (назовем его MyImageClass) с кодом:
Код: Option Explicit
Public WithEvents MyImage As MSForms.Image

Private Sub MyImage_Click()
MsgBox MyImage.Name
'или другой код
End Sub

Подскажите кто-нибудь, пожалуста, как поправить даный код.
К нему есть два вопроса:
1. Как правильно вызвать функцию, чтобы она вернула текстовое значение.
2. Есть набор ComboBox, в которые всталяем значения. Как можно закрутить этот кусочек в цикл, подставляя в каждом номер комбобокса. (В реальной задаче их больше 50). Комбобоксы находятся прямо на листе, а не в форме.


-------------------------------
Function diapazon() ' Функция выбирает диапазон непустых клеток
Dim a As Boolean
Dim diap As String
Dim cur_cell As String
Dim end_cell As String
Dim i As Integer

i = 1
While (a = True)
cur_cell = "A" + LTrim(Str(i))
If (IsEmpty(Sheets("Лист2").Range(cur_cell).Value) = False) Then
end_cell = "A" + LTrim(Str(i))
Else
a = False
End If
i = i + 1
Wend

diapazon = "A1:" + end_cell

End Function
---------
Private Sub Workbook_Open()
'Здесь как-то нужно вызвать функцию diapazon,
'дабы она вернула строковую переменную диапазона
Dim spets_list As Range
Set spets_list = Sheets("Лист2").Range(diapazon)
Dim vars As Variant

For Each vars In spets_list
Лист1.ComboBox1.AddItem (vars)
Лист1.ComboBox2.AddItem (vars)
.................
Лист1.ComboBoxN.AddItem (vars)
Next vars

End Sub
---------------------------------------------------

mcree
Если я не ошибаюсь, то что делает ваша функция диапазон можно написать в 1 строку:

Код: Set spets_list = Range(Cells(1, 1), Cells(1, 1).End(xlToRight))

mcree
Отвечаю на 2-й вопрос.
Цитата:

2. Есть набор ComboBox, в которые всталяем значения. Как можно закрутить этот кусочек в цикл, подставляя в каждом номер комбобокса. (В реальной задаче их больше 50). Комбобоксы находятся прямо на листе, а не в форме.

Комбобоксы и другие контроли на листе входят в коллекцию Shapes. Проблема в том, что в эту коллекцию падают все посторонние объекты на листе, которые могут иметь разные свойства, и разделить объекты по типу не так просто. Можно, конечно, использовать имя объектов (.Name), но тогда надо не забывать включать тип в имя (в принципе, по умолчанию так и есть, например, Combobox1).

Вот более универсальный метод:
Код: Sub LoopThroughComboBoxes()
For Each shp In ActiveSheet.Shapes
If shp.Type = msoOLEControlObject Then
If InStr(shp.OLEFormat.progID, "ComboBox") > 0 Then
shp.Height = 30
shp.Left = 50
shp.OLEFormat.Object.Object.AddItem "abc"
End If
End If
Next
End Sub

Переношу из Excel FAQ:

Sergey MSN
Цитата:

У меня на основе данных из базы данных создается wokbook в котором может быть очень много графиков. Для всех графиков мне бы хотелось, чтобы пользователь мог doubleclick на него и получить некоторые подробности. Для одного конкретного chart все работает, но как это заставить работать для всех chart одиноковым образом?

Если я правильно вас понял, с вашим методом все равно в каждом chart надо что-то прописывать. С тем же успехом я могу туда прописать event в чистом виде.
Разница только в ОБЪЕМЕ кода. Т.е. это работает, но это не элегантно. Sorry, если ошибаюсь.

А мне не хочеться плодить сущности без нужды.

Очередная задача, решаемая с помощью классов. Идея в том, чтобы для каждой диаграммы создать объект нового класса, в котором и прописать, как диаграмма должна откликаться на события. Функция обработки события описывается только один раз в классе. Все что надо сделать - пройтись макросом по всем диаграммам в книге и создать для них объект класса. Например, так:

Код: 'Вверху модуля определяем коллекцию объектов
Dim myChartCol As Collection

Sub Charts2Class()
Dim ch As New myChartClass
Set myChartCol = New Collection
'Для диаграмм отдельным листом
For Each s In ActiveWorkbook.Charts
Set ch.myChart = s
myChartCol.Add ch
Set ch = Nothing
Next
'Для диаграмм, встроенных в листы
For Each s In ActiveWorkbook.Worksheets
For Each co In s.ChartObjects
Set ch.myChart = co.Chart
myChartCol.Add ch
Set ch = Nothing
Next
Next
End Sub

Народ, а подскажите ламеру, как ниписать функцию, которая будет брать значение ячейки из другой книги, при чем нужно чтоб была возможность такая:
при изменениии определенной ячейки (скажем, А1) эта формула брала значение из другой книги , находящейся в каталоге, который и будет указыватья в ячейки
например


Код:
Public a
Function znach(stolb, stroka, put)

' stolb и stroka - адрес ячейки
' put путь к файлу
' данные лежат на листе : Лист1.

a = ???????

If Application.IsNA(a) Then znach = 0 Else znach = a

Yuk.
Огромное спасибо - разобрался. Ура все работает. Повесил все на Workbook_Open.

Только есть в вашем примерчике принципиальная ошибка.

В collection надо схранять не класс Chart, а новый нами созданный класс
Т.е. не
myChartCol.Add ch
а
myChartCol.Add s

Я так понял, что collection здесь нужен только для того, чтобы сделать время жизни экземпляров нового класса глобальным.

Перелопатил все доки кторые нашел. За что я обожаю Мелкософт, так это за точную и толковую документацию
Куча идиотских примеров типа шелкните мышкой здесь, напишите слово здесь и ни одного толкового объяснения как это работает.

Народ кто подскажет как можно сделать чтобы находясь в Excel запустить архивирование самого себя и копирование его на дискету ?

Sergey MSN

Цитата:

Только есть в вашем примерчике принципиальная ошибка.
В collection надо схранять не класс Chart, а новый нами созданный класс

Дык у меня ch и есть наш класс:
Цитата:

Dim ch As New myChartClass

TNR
Заархивировать сaмого себя в экселе - это круто!

Всем привет! Подскажите пожалуйста, как задействовать мышинное колесо в Мультипэйдж (Чтобы скрол бар им прокручивать) . Искал и в Хелпах и в Гуглах Только вот ничего не нашел

Yuk
Спасибо за подсказку. Оказалось, что в функции я потерял строку с присваиванием a=True. Из-за этого ана не работала.
Представленый вами код, почему-то не срабртал. Да и , как я понял, он возьмет диапазон до конца електронной таблицы. А мне нужно только не пустые строки.
Спасибо за подсказку с раскрывающимся списком. Его использование должно капитально сократить код. Но еще нужно подумать ... Я вроде не нашел события на выбор из списка, а оно в моей задаче нужно.
Если у кого-то будут еще предложения буду очень благодарен.

PavelO
Посмотри здесь:
http://www.mvps.org/dmcritchie/excel/scrollbar.htm
Может, этот фикс нужен:
http://office.microsoft.com/en-au/assistance/HA101175901033.aspx



Добавлено:
mcree

Цитата:

Представленый вами код, почему-то не срабртал. Да и , как я понял, он возьмет диапазон до конца електронной таблицы. А мне нужно только не пустые строки.

Нет, до первой непустой ячейки в строке, начиная от А1. Если А2 пустая, до первой непустой. Так же, как использовать клавишу End.


Цитата:

Я вроде не нашел события на выбор из списка

Событие Worksheet_Change. Анализируй переменную Target с If Target.Address или Select Case для многих ячеек. Иногда удобно использовать функцию Intersect. Просмотри этот топик, было много примеров.

"Думаю, надо делать через обработку события Change листа. Условие типа
If Not IsEmpty(Target) Then"
Чем не походит условие, которое я привел?
*****************************************
Yuk

Извините, попробую расписать попонятнее.

Ячейка "первого листа А1" должна переноситься в "ячейку второго листа А1" в том случае, если у соседней "ячейки первого листа А2" стоит любое ненулевое числовое значение, следовательно, "ячейка второго листа А1" автоматом должна блокироваться (подразумевается, что стоит защита на листе, галочка на блокирование с этой ячейки должна сниматься или ставиться взависимости от значения в соседней "ячейке первого листа А2" ) и менять или не менять цвет на "красный" (взависимост от значения в ячейке А2) уже после переноса на другой лист (такое извращение приходится придумывать для бухгалтеров).
Открываю макрос и пишу:
If Not IsEmpty(Target) (Какое нужно указать условие допустим неравно нулю,как это сделать что значит not IsEmpty)Then А1 переносится значение на А1 во второй лист + ставится блокровка и красный цвет иначе должно переноситься пустое значение и ячейка автоматом должна разблокироваться и поменять цвет на черный.
Помогите полностью записать код...

Vladimir54
Несколько раз перечитал и ничего не понял. Давайте еще раз. Желательно по-русски, без пропуска слов и со знаками препинания. Представьте, что вы объясняете для своих бухгалтеров.

перенес из топика Excel

Код: Sub Cell2Text()
Dim c As Range
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
For Each c In Range("A1:A2")
Set f = fs.CreateTextFile(c.Text & ".txt", True)
f.writeline "[enter]"
f.writeline "[wait inp inh]"
f.writeline "wait 10sec until FieldAttribute 0000 at (3.22)"
f.writeline "wait 10 sec until cursor at (3.23)"
f.writeline "[wait app]"
f.writeline Chr(34) & c.Text & Chr(34)
f.Close
Next
End Sub

Было не понятно, нужен вывод в один файл или в отдельный файл для каждого счета. Сделал для каждого. Если нужно в один, вынеси за цикл создание файла и закрытие.


Добавлено:
Да, не забудь изменить область ячеек, откуда брать значения в Range("A1:A2"). Если нужна динамическая область, смотрим (или задаем вопрос) в соответствующем топике.

Troll
Изменений немного:
Код: ...
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.CreateTextFile("output.txt", True)
For Each c In ActiveSheet.UsedRange.Columns(1).Cells
f.writeline "[enter]"
...
f.writeline Chr(34) & c.Text & Chr(34)
Next
f.Close
End Sub

Всем привет! Не могу понять... Есть такой простой макрос:
-------------------------------------
Private Sub Workbook_Open()
Dim RN As Integer, CN As Integer, SumCh As Byte, ch As Byte

RN = 240
CN = 2

Do Until Cells(RN, CN) = 200
RN = RN - 1
If Cells(RN, CN) <> "" Then
SumCh = 0
For CN = 4 To 7
If Cells(RN, CN) = "" Then
ch = 0
Else: ch = 1
End If
SumCh = SumCh + ch
Next CN

If SumCh = 0 Then
Columns(RN).Select
Selection.EntireColumn.Hidden = True
End If
End If
Loop

End Sub
--------------------------

При открытии книги вылазит 1004 Error: "Application-defined or object-defined error"
Иду в дебуг при ошибке. Тормозится на начале цикла, причем значения RN и CN - 0 и 8 соответственно. А если прогонять макрос трассировкой, то все прекрасно выполняется.
Че за лажа?

sonix555
По всей видимости во 2-м столбце нет ячейки со значением 200.
Рекомендую явно прописать какой лист активировать Sheets(1).Activate. Или так: Sheets(1).Cells(RN,CN).Value

Yuk
Я отредактировал сообщение вверху.

Vladimir54
Спасибо, уже более менее.
Если я правильно понял, надо обрабатывать событие изменения ячейки А2 1-го листа.
Тогда в код 1-го листа примерно такой код:
Код: Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then
If Not IsEmpty(Target) And IsNumeric(Target.Value) Then
With Sheets(2).Cells(1, 1)
.Value = Sheets(1).Cells(1, 1).Value
.Locked = True
.Font.ColorIndex = 3
End With
Sheets(1).Cells(1, 1).Value = ""
End If
End If
End Sub

Как сделать в Excel кнопку при нажатии на которую файл будет паковаться и копироваться на дискету ?

TNR
См. функцию Shell в VBA. Запуск внешних программ. Запускаешь архиватор как из командной строки или через батник.

создал cmd файл там прописал параметры запаковки, а он не запускается !
файл находиться в одной папке с файлом excel.
Как его заставить запускать этот cmd ?

TNR
Сделать макро и повесить на кнопку. Код примерно такой:

Код: Sub Archive()
Shell "path\to\your\file.cmd"
End Sub