Rambler's Top100
Форум: MS ACCESSVBVBA MS OfficeMS SQL server
Новые сообщения: 0000

Форум: MS ACCESS

Вопросы связанные с MS ACCESS

Обновить визитку
Участники «Online»
Все участники

 
 

Доброго времени суток, Посетитель!

вид форума:
Линейный форум Структурный форум

тема: Помогите сократить код пожалуйста
 
 автор: Скорп   (15.01.2011 в 13:00)   личное сообщение
33 Кб.
 
 

На форме справа (см рис) 15 полей, по клику на которых появляется подформа.
На полях висит код, который раскрашивает поле при клике по этому полю.

Me.ТекстНадпись.BackColor = 62207
Me.ТекстНадпись.ForeColor = 255
Me.ТекстНадпись.FontBold = 1

Me.ОбложкаНадпись.BackColor = 16777215
Me.ОбложкаНадпись.ForeColor = 0
Me.ОбложкаНадпись.FontBold = 0

Me.ФорзацНадпись.BackColor = 16777215
Me.ФорзацНадпись.ForeColor = 0
Me.ФорзацНадпись.FontBold = 0

Me.НахзацНадпись.BackColor = 16777215
Me.НахзацНадпись.ForeColor = 0
Me.НахзацНадпись.FontBold = 0

Me.ВкладкаНадпись.BackColor = 16777215
Me.ВкладкаНадпись.ForeColor = 0
Me.ВкладкаНадпись.FontBold = 0

Me.ФронтисписНадпись.BackColor = 16777215
Me.ФронтисписНадпись.ForeColor = 0
Me.ФронтисписНадпись.FontBold = 0

Me.СуперобложкаНадпись.BackColor = 16777215
Me.СуперобложкаНадпись.ForeColor = 0
Me.СуперобложкаНадпись.FontBold = 0

Me.ПереплетКорешокНадпись.BackColor = 16777215
Me.ПереплетКорешокНадпись.ForeColor = 0
Me.ПереплетКорешокНадпись.FontBold = 0

Me.КапталНадпись.BackColor = 16777215
Me.КапталНадпись.ForeColor = 0
Me.КапталНадпись.FontBold = 0

Me.ЛяссеНадпись.BackColor = 16777215
Me.ЛяссеНадпись.ForeColor = 0
Me.ЛяссеНадпись.FontBold = 0

Me.ТиснениеНадпись.BackColor = 16777215
Me.ТиснениеНадпись.ForeColor = 0
Me.ТиснениеНадпись.FontBold = 0

Me.КонвертНадпись.BackColor = 16777215
Me.КонвертНадпись.ForeColor = 0
Me.КонвертНадпись.FontBold = 0

Me.СчетНадпись.BackColor = 16777215
Me.СчетНадпись.ForeColor = 0
Me.СчетНадпись.FontBold = 0

Me.УпаковкаНадпись.BackColor = 16777215
Me.УпаковкаНадпись.ForeColor = 0
Me.УпаковкаНадпись.FontBold = 0

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

  Ответить  
 
 автор: snipe   (15.01.2011 в 13:27)   личное сообщение
 
 

пишем функцию
где все поля загоняем
.BackColor = 16777215
.ForeColor = 0
.FontBold = 0

на событие клик
вызываем функцию (поля "обнуляются")
красим конкретное поле в нужные цвета

можно функции передавать имя поля
и красить из под функции

добавлено
это в модуль формы

Private function Boxcolor (asd as string)
Me.ТекстНадпись.BackColor = 16777215
Me.ТекстНадпись.ForeColor = 0
Me.ТекстНадпись.FontBold = 0

Me.ОбложкаНадпись.BackColor = 16777215
Me.ОбложкаНадпись.ForeColor = 0
Me.ОбложкаНадпись.FontBold = 0

Me.ФорзацНадпись.BackColor = 16777215
Me.ФорзацНадпись.ForeColor = 0
Me.ФорзацНадпись.FontBold = 0

Me.НахзацНадпись.BackColor = 16777215
Me.НахзацНадпись.ForeColor = 0
Me.НахзацНадпись.FontBold = 0

Me.ВкладкаНадпись.BackColor = 16777215
Me.ВкладкаНадпись.ForeColor = 0
Me.ВкладкаНадпись.FontBold = 0

Me.ФронтисписНадпись.BackColor = 16777215
Me.ФронтисписНадпись.ForeColor = 0
Me.ФронтисписНадпись.FontBold = 0

Me.СуперобложкаНадпись.BackColor = 16777215
Me.СуперобложкаНадпись.ForeColor = 0
Me.СуперобложкаНадпись.FontBold = 0

Me.ПереплетКорешокНадпись.BackColor = 16777215
Me.ПереплетКорешокНадпись.ForeColor = 0
Me.ПереплетКорешокНадпись.FontBold = 0

Me.КапталНадпись.BackColor = 16777215
Me.КапталНадпись.ForeColor = 0
Me.КапталНадпись.FontBold = 0

Me.ЛяссеНадпись.BackColor = 16777215
Me.ЛяссеНадпись.ForeColor = 0
Me.ЛяссеНадпись.FontBold = 0

Me.ТиснениеНадпись.BackColor = 16777215
Me.ТиснениеНадпись.ForeColor = 0
Me.ТиснениеНадпись.FontBold = 0

Me.КонвертНадпись.BackColor = 16777215
Me.КонвертНадпись.ForeColor = 0
Me.КонвертНадпись.FontBold = 0

Me.СчетНадпись.BackColor = 16777215
Me.СчетНадпись.ForeColor = 0
Me.СчетНадпись.FontBold = 0

Me.УпаковкаНадпись.BackColor = 16777215
Me.УпаковкаНадпись.ForeColor = 0
Me.УпаковкаНадпись.FontBold = 0

Me(asd).BackColor = 62207
Me(asd).ForeColor = 255
Me(asd).FontBold = 1

end function

Пример вызова
Private Sub ТекстНадпись_Click()
call Boxcolor(ActiveControl.Name)
End Sub

  Ответить  
 
 автор: shanemac51   (15.01.2011 в 14:20)   личное сообщение
 
 




Private Sub Кнопка12_Click()
MM Me.ActiveControl.Name

Me![КонтролПодФормы].SourceObject = "СемПоложение" 'работа - это имя формы используемой в качестве подчиненной
End Sub
Sub MM(N1Z)
Dim CNT As Control
'' дополнительные сведениея кнопок выбора содержат WW --для флажка
For Each CNT In Me.Controls
If CNT.Tag = "WW" Then
If N1Z = CNT.Name Then
'
CNT.ForeColor = 255
CNT.FontBold = 1
Else
'CNT.BackColor = 16777215
CNT.ForeColor = 0
CNT.FontBold = 0
End If
End If
Next CNT
End Sub

  Ответить  
 
 автор: Lukas   (15.01.2011 в 14:51)   личное сообщение
 
 


...
For Each CNT In Me.Controls
If CNT.Tag = "WW" Then
If N1Z = CNT.Name Then
...

Много лишней работы процессору.

  Ответить  
 
 автор: Дрюня   (15.01.2011 в 14:09)   личное сообщение
 
 

Нужно использовать коллекцию Me.Controls
и делать анализ по вхождению в свойство .Name строки "Надпись"

  Ответить  
 
 автор: Lukas   (15.01.2011 в 14:40)   личное сообщение
 
 

В модуле формы:

Option Compare Database
Option Explicit
Private ActiveLabel As Label

Private Sub Form_Open(Cancel As Integer)
    LabelActivate Me.Controls("ТекстНадпись") 'Имя Label активной по-умолчанию(первой)
End Sub

' вызываем и передаем ссылку на Label при клике(например)
Private Sub LabelActivate(NewActiveLabel As Label) 
    If Not ActiveLabel Is Nothing Then
        With ActiveLabel
            .BackColor = 16777215
            .ForeColor = 0
            .FontBold = 0
        End With
    End If
    Set ActiveLabel = NewActiveLabel
    With ActiveLabel
        .BackColor = 62207
        .ForeColor = 255
        .FontBold = 1
    End With
End Sub

Не проверял, писал "на глаз". :)

  Ответить  
 
 автор: AlexSyr   (15.01.2011 в 16:31)   личное сообщение
12 Кб.
 
 

Судя по вкладке (частью попавшей сверху на рисунке) - возможно у Вас MSA не ниже 2007?
Если это так, то наверное можно было бы поиграться с "элементом навигации"
По крайней мере, описанную проблему с кодом, точно решит.

  Ответить  
 
 автор: AlexSyr   (15.01.2011 в 16:55)   личное сообщение
 
 

Ой, извиняюсь!!!
Этот элемент, вроде как только с MSA2010 доступен.

  Ответить  
 
 автор: Скорп   (15.01.2011 в 20:49)   личное сообщение
 
 

таа-а-а-ак, ясно в общих чертах
посижу, выберу какой-нить вартиант и отпишусь

выбрал вариант snipe, как наиболее для меня понятный
хотя, вариант Лукаса наиболее красивый мне кажется, но чета я его не догоняю, где что прописать и как вызывать

  Ответить  
 
 автор: Lukas   (15.01.2011 в 22:08)   личное сообщение
15 Кб.
 
 

Примеры. =>
Есть еще варианты, более наркоманские. :)

  Ответить  
 
 автор: Скорп   (15.01.2011 в 22:27)   личное сообщение
 
 

Красиво!
слов нет..
спасибо всем!

  Ответить  
 
 автор: snipe   (16.01.2011 в 05:52)   личное сообщение
 
 

если ваши "кнопки" обозвать хитрым образом
одним словом состоящим из текстовой и цифровой составляющих причем текстовая часть одинаковая для всех, а цифровая - последовательные натуральные числа то можно код сократить

обзываем "Кнопочка1", "Кнопочка2, "Кнопочка3", "Кнопочка4", "Кнопочка5".........."Кнопочка15"

Private function Boxcolor (asd as string)
for i=1 to 15
Me("Кнопочка" & i).BackColor = 16777215
Me("Кнопочка" & i).ForeColor = 0
Me("Кнопочка" & i).FontBold = 0
next i
Me(asd).BackColor = 62207
Me(asd).ForeColor = 255
Me(asd).FontBold = 1
end function

Пример вызова
Private Sub Кнопочка1_Click()
call Boxcolor(ActiveControl.Name)
End Sub

  Ответить  
 
 автор: Lukas   (16.01.2011 в 12:53)   личное сообщение
 
 

Зачем перебирать и изменять значения свойств 15-ти лейблов, если "активным" в любой момент времени может быть только один?
Не проще "запомнить", который из них "активировался" последним?

  Ответить  
 
 автор: snipe   (16.01.2011 в 13:31)   личное сообщение
 
 

а если Label на форме 30 а нужно только 15

  Ответить  
 
 автор: Lukas   (16.01.2011 в 13:43)   личное сообщение
 
 

Ну посмотри мой код.
Один лабел "текущий активный" (его "запомнили" ранее), второй нужно сделать "активным".
Скинули в дефолт значения свойств "текущего активного".
Сделали "текущим" новый, установили значения свойств для "активного".

Все.
3 шага.
Никаких лишних переборов контролов и проверок значений их свойств.

  Ответить  
 
 автор: shanemac51   (16.01.2011 в 13:47)   личное сообщение
 
 


что будет предыдущим перед первым нажатием активной кнопки

  Ответить  
 
 автор: Lukas   (16.01.2011 в 13:48)   личное сообщение
 
 

А в моем коде что, этого не видно?

  Ответить  
 
 автор: Lukas   (16.01.2011 в 13:49)   личное сообщение
 
 


...
Private Sub Form_Open(Cancel As Integer)
    LabelActivate Me.Controls("ТекстНадпись") 'Имя Label активной по-умолчанию(первой)
End Sub 
...

  Ответить  
 
 автор: AlexSyr   (16.01.2011 в 16:47)   личное сообщение
 
 



Private Sub Form_Open(Cancel As Integer)
  Dim ctlL As Label
  For Each ctlL In Me.Controls
    ctlL.OnClick = "=LabelActivate(" & ctlL.Name & ")"
  Next

    LabelActivate Me.Controls("lbl1") 'Имя Label активной по-умолчанию(первой)
End Sub

  Ответить  
 
 автор: Lukas   (16.01.2011 в 18:28)   личное сообщение
 
 


...
For Each ctlL In Me.Controls 
    ctlL.OnClick = "=LabelActivate(" & ctlL.Name & ")" 
...

Ну ладно у меня в примере одни только нужные Labels, а ежели в реальной форме?
Отлуп по полной получится. :)

  Ответить  
 
 автор: AlexSyr   (16.01.2011 в 21:02)   личное сообщение
 
 

Безусловно!
Нужно делать анализ на какой контрол ставить обработку события.
Ну, а если таких элементов будет не 15, а 115

  Ответить  
 
 автор: Lukas   (16.01.2011 в 22:55)   личное сообщение
 
 

Легко.
Вариантов, как обычно, несколько.
:)

  Ответить  
 
 автор: AlexSyr   (17.01.2011 в 10:25)   личное сообщение
 
 

Вариантов заполнения однотипных свойств элементов м.б. несколько - согласен, но реально работающих (по скорости разработки/открытия/видоизменения/...), наверное, найдется пару - не более.
Может обсудим это в другой теме?

  Ответить  
 
 автор: Lukas   (17.01.2011 в 12:39)   личное сообщение
 
 

Сейчас занят. Вечером?

  Ответить  
 
 автор: AlexSyr   (17.01.2011 в 14:17)   личное сообщение
 
 

Тогда до после Дня Варенья

  Ответить  
 
 автор: shanemac51   (16.01.2011 в 08:20)   личное сообщение
 
 



''так даже удобнее, вставила в собственную задачу,  сразу видна нажимаемая кнопка

For Each CNT In Me.Controls
If CNT.controlType =  acCommandButton Then
If N1Z = CNT.Name Then 

  Ответить  
 
 автор: Lukas   (16.01.2011 в 12:56)   личное сообщение
 
 

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

  Ответить  
 
 автор: shanemac51   (16.01.2011 в 13:19)   личное сообщение
 
 

надо изменить цвет одной из 15 кнопок за период времени от нескольких секунд до минут

не ахти какие нагрузки процессору
лучше чем километровый сложно отслеживаемый модуль -- тоже процессору не подарок

  Ответить  
 
 автор: Lukas   (16.01.2011 в 13:36)   личное сообщение
 
 

Зачем при этом перебирать все контролы формы?
Если посмотреть на скрин формы в первом посте, видно, что изменять свойства нужно 2 контролам,
а перебирать и читать свойства при этом придется значительно большему числу контролов.
Зачем? Если можно изменить значения свойств только двух контролов, без перебора всей коллекции.
Или у Вас дома холодно, и вы греетесь от тепла, выделяемого процессором? :)

  Ответить  
 
 автор: shanemac51   (16.01.2011 в 13:40)   личное сообщение
 
 


никто не мешает
-списать имена кнопок в массив и не менять значение, если оно уже равно требуемому
-или помнить предыдущий и менять активный и предыдущий

  Ответить  
 
 автор: Lukas   (16.01.2011 в 13:46)   личное сообщение
 
 


никто не мешает
-списать имена кнопок в массив и не менять значение, если оно уже равно требуемому
...


Опять перебор, только уже элементов массива.


никто не мешает
...
-или помнить предыдущий и менять активный и предыдущий


Вот за это я и ратую.

  Ответить  
 
 автор: Скорп   (16.01.2011 в 14:53)   личное сообщение
 
 

Несерьезные программки у Лукаса какие-то, на 2-х - 3-х листиках код умещается наверное.
Воо-о-от у меня....!!! Сразу уважение вызывает и видно, что чел (т.е. я) работаю...

  Ответить  
HiProg.com - Технологии программирования
Rambler's Top100 TopList