Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Всплывающая подсказка при наведении курсора на фигуру
 
Получились кнопки с подсветкой И подсказками сделаны так  
 
Код:  
 
 
Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)  
CommandButton1.Font.Bold = True  
CommandButton1.BackColor = &HFF00&  
'With CommandButton1  
'.ControlTipText = "Телефоны клиентов"  
'End With  
End Sub  
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)  
CommandButton1.Font.Bold = False  
CommandButton1.BackColor = &H8000000F  
End Sub  
 
работает но  
1. всплывающие подсказки сделал гиперссылками что плохо  
как Поставить на событие MouseMove появление надписи ?  
пробовал  
Код:  
 
 
'With CommandButton1  
'.ControlTipText = "Телефоны клиентов"  
'End With  
 
не работает тк вроде такое только в форме можно сделать  
 
2.бывает что цвет подсветки не меняется(не убирается), когда убираешь курсор или макрос срабатывает  
как это побороть?  
советовали - расширьте размер Image - но это не подходит тк при клике под кнопкой можно случайно попасть в поле Image  
 
файл с примером во вложении
Проверка на заполнение ячеек в строке
 
Проблема была как сделать так, чтобы заставить пользователя обязательно внести информацию в нужные ячейки при заполнении. Например, если ячейка А2 непустая, то запретить пользователю переход на другую строку (запрет выделения ячеек на других строках), если ячейки D2 и G2 пустые. А ячейку A2 запретить изменять, если пустая ячейка A1. Соответственно, тот же случай с ячейками А3 и D3,G3 и т.д.  
 
За основу взял несколько примеров все глючили  - вот один поправил вроде работает  
Получилось выделить исходный диапазон – проверил ошибок не выдает  
 
Осталось сделать подсветку незаполненных ячеек в строке  вместо  MsgBox  + если не заполнены ячейки хотя бы в одной строке – не дает переходить с листа на лист и закрыть файл – вылазит  табличка "Полностью Заполните поля строки !"  
Пока не знаю как реализовать- кто поможет HELP    
 
Файлик прилагаю.  
 
 
Код  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
flag = 0  
If Target.Column >= 2 And Target.Column <= 7 And Target.Row > 8 And Target.Row <= 701 Then ‘ вводим диапазон где будет проверка  
For j = 2 To 7 Step 1  
If Cells(Target.Row - 1, j) = "" Then  
flag = 1  
End If  
Next j  
If flag = 1 Then  
Application.EnableEvents = False  
Target.Value = ""  
Application.EnableEvents = True  
MsgBox ("Заполните всю информацию по дате")  
End If  
End If  
End Sub
Добавление новых строк на 2 листах по условиям
 
сделано
Выпадающий календарь - доработать под задачу
 
Формулировки может неправильно написал и тон не понравился - ладно поменяем ...сорри А решения выкладываемые на Вашем форуме сильно помогают же не только мне но и всем участникам
Выпадающий календарь - доработать под задачу
 
Да нет никакого ТЗ - я пытаюсь подробно расписать что надо чтоб 10 раз потом вопросы не задавать тк часто беспокоить Вас тоже не резон. Свою задачу на 70 проц решаю сам а вопросы задаю чтоб на этапах сильно не застревать вот и все
Выпадающий календарь - доработать под задачу
 
Есть очень хороший выпадающий календарь  - хотелось бы его доработать под следующую задачу:  
Календарь вводит дату и время в одну ячейку  а надо чтоб вводил дату в одну ячейку а время во 2 ячейку справа   - как в примере (прилагаю файл)      
Например Дата в G:11 Время H:11   -   Дата в G:12 Время H:12    и тд  
 
При этом ввод времени в форме календаря переделать в виде выпадающего списка (поля и кнопки установки времени убрать) – для времени остается одно поле с выпадающим списком  
Выпадающий список взять с листа «Время» в приложенном файле.  
 
Календарь нужно привязать к вводу только в диапазон G10:H500  
Причем в столбец G вводим дату,  в столбец H – время  
 
Впоследствие путем сортировки на даты – а потом сортировки на время внутри даты  получается план на день с утра
Добавление новых строк на 2 листах по условиям
 
Сейчас выпадающем окне формы ввода сделано 1 поле общее  
а  нужно 2 поля Наименование и Форма собственности
Добавление новых строк на 2 листах по условиям
 
Уже помогли сделанный файл во вложении  
 
Вопрос только один появился позднее ранее не учел.  
Проблема такая: при вводе предприятия манагеры часто ошибаются - пишут то "ООО Горизонт" то "Горизонт ООО" то просто "Горизонт" а то вообще забывают написать название- а надо чтоб было Горизонт,ООО - чтоб можно было сортировку и поиск производить нормально + форму знать ООО это или ИП  
 
Те видимо в выпадающем окне формы ввода нужно 2 поля - 1-е:Наименование предприятия 2-е: Форма собственности и потом они попадают в ячейку листа уже в нужном формате и порядке(желательно с запятой сделать) - Горизонт,ООО
Добавление новых строк на 2 листах по условиям
 
Как добавить новую строку (последнюю) одновременно в 2 листа книги по кнопке макроса  
Условия такие:  
1. Новые строки добавляются только в листы книги «Список» и «Мероприятия»  
2. Ячейки листов «Список» и «Мероприятия» связаны ссылками по условиям =Список!C5 и тд на листе «Мероприятия»  
3. В новой строке на листах «Список» и «Мероприятия» сохраняется форматирование и формулы предыдущей строки (или 1вой как образец либо в макросе сразу прописать формулы которые надо вставить)  
4. В новой ячейке в столбце № листа «Список»появляется следующий порядковый номер( те +1), в остальных ячейках новой строки дб пусто ( с сохранением форматирования)  
6. Кнопка макроса на листе «Список» - по ее нажатию выскакивает окно формы с надписью « Заполните название предприятия» - ОК – запись попадает в новую строку в столбце Предприятие( если предприятие не заполнено то ОК не срабатывает)
Добавление новых строк на 2 листах по условиям
 
Как одновременно добавить 2 строки в последнюю в 2 листа книги по кнопке макроса Условия такие:  
1. Доп строки добавляются только в листы книги  «Список» и «Мероприятия»  
2. Ячейки листов «Список» и «Мероприятия» связаны ссылками по условиям =Список!C5 и тд на листе «Мероприятия»  
3. В дополнительной созданной строке на листах  сохраняется форматирование  
предыдущей строки    
4. В дополнительной созданной ячейке в столбце № листа «Список»появляется следующий порядковый номер( те +1), в остальных  ячейках  новой строки дб пусто ( с сохранением форматирования)  
5. В дополнительной созданной строке на листе  «Мероприятия» сохраняется форматирование и формулы предыдущей строки    
6. Кнопка макроса на листе «Список» - по ее нажатию выскакивает  окно формы  
с надписью « Заполните название предприятия» - ОК – запись попадает в новую строку ( если предприятие не заполнено то ОК не срабатывает)
Копирование строки формул при добавлении текста в ячейку
 
прямая зависимость есть - вид формул вид формулы в С вида =список!B10 ==список!B11 и тд
Копирование строки формул при добавлении текста в ячейку
 
пример Hugo121 смотрел конечно - но как заставить макрос найти измененное значение на сводном листе и протянуть верхнюю ячейку на измененное значение не знаю ...    
Для dl - вид формулы в С вида =список!B10 ==список!B11 и тд со ссылкой только на  лист Список (ссылочный лист не переменный)  
R Dmitry предложил привязать события к изменениям на другом листе - как это сделать ??
Копирование строки формул при добавлении текста в ячейку
 
Может из-за формул ссылок макрос текст не видит ??  
Как то было при макросе поиска тоже не видел текст, формируемый ссылками с другого листа  
Код:  
Public Sub Searsh()  
   Cells.Find(What:=[C4], After:=ActiveCell, LookIn:=xlFormulas, LookAt _
       :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _  
       False, SearchFormat:=False).Activate  
End Sub  
не работал по ссылкам изменили на  
Код:  
Public Sub Searsh()  
   Cells.Find(What:=[C4], After:=ActiveCell, LookIn:=xlValues, LookAt _
       :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _  
       False, SearchFormat:=False).Activate  
End Sub  
 
то есть LookIn:=xlFormulas поменяли на LookIn:=xlValues  
и заработало - макрос текст стал видеть
Копирование строки формул при добавлении текста в ячейку
 
выше мой пост
Как скрыть пустые строки с "0" значением
 
снятие нулевых значений не помогает
Как скрыть пустые строки с "0" значением
 
суть проблемы в том что при сортировке по убыванию-возрастанию пустые строки с 0 значением попадают в мою таблицу что неудобно
Как скрыть пустые строки с "0" значением
 
нужно по условию в диапазоне именно столбцы B:O; если там есть 1усл-просто пусте строки 2усл - пустые строки но попадаются 0 из-за введеных формул  
 
то подобные строки скрываются  
 
в моем случае надо скрыть строки с A8 и все что ниже ( одну пустую строку A7 оставить)
Как скрыть пустые строки с "0" значением
 
ДИАПАЗОН В КОТОРОМ НАДО ПРИМЕНЯТЬ УСЛОВИЯ - столбцы B:O   не указал  к сожалению в примере  
 
сейчас файл прикрепил который надо
Как скрыть пустые строки с "0" значением
 
Есть в таблице пустые строки с "0" значением тк введены формулы  и просто пустые    
Как их скрыть  
 
 
Пример в файле
Условное форматирование с помощью управляющего листа
 
Реализовано условное форматирование с помощью управляющего листа  
но только цвета ячеек  
 
Как добавить форматирование шрифта (цвет, толщину) ?  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target.Column <> 1 Then Exit Sub  
   If Target.Count > 1 Then Exit Sub  
   If Target = "" Then  
       Target.Interior.ColorIndex = xlNone: Exit Sub  
   End If  
   Dim x As Range, s As String  
   s = Application.Trim(Replace(Split(Target, "-")(0), "", ""))  
   Set x = Sheets(2).[A:A].Find(Split(s, " ")(0))
   If x Is Nothing Then Exit Sub  
   If x.Interior.ColorIndex <> xlNone Then Target.Interior.ColorIndex = x.Interior.ColorIndex  
     
End Sub  
 
 
файл прилагаю
Копирование строки формул при добавлении текста в ячейку
 
Так сделать если  
Range("C11").Select  
Selection.AutoFill Destination:=Range("C11:C3993"), Type:=xlFillDefault  
Range("C11:C3993").Select  
Range("C11").Select  
?? куда и как вставить?
Копирование строки формул при добавлении текста в ячейку
 
Видимо надо сначала проверить при отрытии листа в макросе какие ячейки в столбце С (исх значения) имеют текст а потом "протянуть" на них одну верхнюю ячейку как вариант
Копирование строки формул при добавлении текста в ячейку
 
Поторопился с тем что все работает ...  
Проблема следующая:  
Если текст в исх ячейках С12 С13 С14 и тд появляются, стирается или  изменяется не ручным вводом текста а по формуле ссылки из другого листа -  то то пересчет формул не ведется  
 
Пересчет ведется когда записи в колонку С добавляешь или изменяешь на текущем листе  
 
Файл прилагаю
Копирование строки формул при добавлении текста в ячейку
 
************************************************  
If IsNumeric(ch.Value) Then Range(Cells(ch.Row, 7), Cells(ch.Row, 9)).ClearContents  'стирание  
   [A10:J4004].WrapText = True 'переносим по словам
   [A10:J4004].EntireRow.AutoFit 'подбираем высоту
   End If  
   Next  
   Application.EnableEvents = True  
   Application.ScreenUpdating = True 'включаем ScreenUpdating  
 
End Sub  
 
все поправил все работает  
ОГРОМНАЯ БЛАГОДАРНОСТЬ ЗА ПОДДЕРЖКУ !!!!
Копирование строки формул при добавлении текста в ячейку
 
[A10:J4004].WrapText = True 'переносим по словам
[A10:J4004].EntireRow.AutoFit 'подбираем высоту
Копирование строки формул при добавлении текста в ячейку
 
В исходном макросе  
Private Sub Worksheet_Change(ByVal Target As Range)  
Application.ScreenUpdating = False 'чтоб не моргало  
On Error Resume Next  
If Target.Row = 11 Then Exit Sub  
If Target.Column = 3 Then  
Debug.Print Target.Address  
For Each ch In Target  
Range(Cells(ch.Row, 7), Cells(ch.Row, 9)) _  
= [g11:i11].Formula
If ch.Value = "" Then Range(Cells(ch.Row, 7), Cells(ch.Row, 9)).ClearContents  
If IsNumeric(ch.Value) Then Range(Cells(ch.Row, 7), Cells(ch.Row, 9)).ClearContents  
Next  
End If  
End Sub  
 
2 строка котору добавил  
Application.ScreenUpdating = False 'чтоб не моргало  
все портила  
Удалил - все стало нормально  
Конечно с ней приятнее работать - при выполнении макроса экран не моргает  
 
Осталось только Ошибку 1 поправить
Копирование строки формул при добавлении текста в ячейку
 
Еще пара ошибок - хотелось бы исправить  
1.Если ввожу текст выше диапазона С11  то формулы появляются что не дожно быть  
Диапазон ввода текста в стобце С дб С11:C500  
Диапазон формул  G11:I500  
Как ограничить диапазон ?  
2.Если удалять в диапазоне С исх значения то формулы и значения стираются - все нормально  
Но уменя какой-то глюк - если стираю кнопкой DEL или удалить - все нормально  
если в меню Очистить содержимое - все виснет    
С чем может быть это связано ?
Копирование строки формул при добавлении текста в ячейку
 
Работает макрос так  
Ячейка С11 (только текстовые данные)заполнена напротив в ячейках G11 H11 I11 находятся образцы формул  
Ввожу текст в ячейку С12 - формулы появляются в ячейках G12 H12 I12;  
Ввожу текст в ячейку С13 - формулы появляются в ячейках G13 H13 I13;  
и тд  
Если стер текст ( из ячейки допустим С13) - формулы в ячейках G13 H13 I13 убираются  
Если стер формулы из ячеек G13 H13 I13 то при вводе нового текста в ячейку С13 формулы вновь работают  
Ввод формул работает при наборе текста а не числовых значений (как условие)  
Сделано для того чтоб не плодить в большом массиве данных формулы (иначе тормозит таблица при пересчете ячеек) а добавлять формулы в требуемые ячейки при появлении исх данных  
 
 
Проблема следующая:  
Если текст в исх ячейках С11 С12 С13 и тд появляются не ручным вводом текста а по формуле ссылки - я путем "перетаскиванием" формулы по столбцу ввожу ссылки в нижние ячейки столбца С  
(ТО ЕСТЬ ЗАНОШУ ЗНАЧЕНИЯ СРАЗУ ОДНОВРЕМЕННО В НЕСКОЛЬКО ЯЧЕЕК СТОЛЦА) то то пересчет формул не ведется  
 
Пересчет ведется когда только по одной дополн записи в колонку С добавляешь  
 
Посоветовали в код макроса добавить принудительный пересчет формул:  
Else  
Application.Volatile  
If  
или    
Else  
ActiveSheet.Calculate    
If  
но данный вариант чегото не сработал  
 
 
Код:  
 
 
Private Sub Worksheet_Change(ByVal Target As Range)  
On Error Resume Next  
If Target.Row = 11 Then Exit Sub 'строка начала диапазона текста(задаем диапазон текста)  
If Target.Column = 3 Then ' столбец начала диапазона текста(задаем диапазон текста)  
Debug.Print Target.Value  
Range(Cells(Target.Row, 7), Cells(Target.Row, 9)) _  
= [g11:i11].Formula ' диапазон столбцов+диапазон исх ячеек с формулами
If Target.Value = "" Then Range(Cells(Target.Row, 7), Cells(Target.Row, 9)).ClearContents 'условие на стирание  
If IsNumeric(Target.Value) Then Range(Cells(Target.Row, 7), Cells(Target.Row, 9)).ClearContents 'условие на стирание  
End If  
End Sub  
 
Как это можно поправить ?  
 
Файл прилагаю
Страницы: 1
Наверх