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

Страницы: 1 2 След.
Добавить строки в умную таблицу
 
Здравствуйте. Код работает, когда число добавляемых сторк не превышает количества строк до следующей умной таблицы. Если нужно добавить 20 или 40, то выходит ошибка. Как макросом можно добавить любое количество строк? Для теста нужно выбрать имя производителя (заголовок таблицы) и кнопку добавления строк. Заранее спасибо
Замена данных в столбце всех умных таблиц
 
Здравствуйте. Насобирал код по замене значений в столбце "Коэф-нт" в выбранной таблице (строка в Listbox). А как сделать, чтобы заменить значения во всех таблицах книги? Таблицы все однотипные. Нужно только игнорировать листы "Калькуляция" и "Копия" - на них другие таблицы. Файл приложил
Выделение активной ячейки
 
Здравствуйте. По умолчанию цвет рамки курсора зелёного цвета. Можно её программно изменить на красный? Если невозможно, то другой вопрос. При выборе combobox (на форме), ячейка становится активной. Возможно её залить, к примеру в жёлтый, но при выборе следующей ячейки через combobox, с прежней выбранной ячейки снималась заливка, а заливалась новая выбранная? Нюанс ещё в том, что ячейки выбираются в умной таблице со стилем "TableStyleLight21" и, если отменять заливку на бесцветный, то у таблицы будет вид с белыми "дырами", а определять какая заливка была ранее у аткивной ячейки наверно нереально. Я не настаиваю именно на таком решении вопроса. Может что-то посоветуете, но в идеале было бы сменить цвет рамки курсора.  
Результат работы макроса на лист
 
Здравствуйте. Прошу доработать код. Полученные значения "а" чтобы записывались на лист "Настройки" в столбец "C"  с третьей строки и ниже. Полученные значения "b" чтобы записывались на лист "Настройки" в столбец "D"  с третьей строки и ниже. Полученные значения "c" чтобы записывались на лист "Настройки" в столбец "F"  с третьей строки и ниже. Спасибо
Код
Private Sub CommandButton1_Click()
 Dim a As Variant
 Dim b As Variant
 Dim c As Variant
Dim sheet As Worksheet, LO As ListObject
For Each sheet In Sheets
For Each LO In sheet.ListObjects
With LO
  a = .Name
  'MsgBox a
  b = .Parent.Name
  'MsgBox b
  c = .Range.Address
  'MsgBox c
End With
Next
Next
End Sub
Заполнение ListBox и уданение из него значения
 
Здравствуйте. Может спрашиваю чушь несусветную: можно как-то заполнять ListBox, не задействуя лист и не вписявая вручную в UserForm_Initialize. А, к примеру, как у меня на форме, вносим в TextBox значение, кнопкой 1 заносим его в ListBox, а это значение бы записывалось в  UserForm_Initialize. И наоборот, при выборе в ListBox, кнопкой 2 удалялось. Просто ради небольшого списка держать лист... Что скажите?
Не выполняется часть действий в макросе
 
Здравствуйте. В процессе работы в книге заполняется лист "Калькуляция". После окончания работы лист "Калькуляция" копируется, сохраняется в новой книге, которая закрывается. В книге, которой вели заполение, таблицы очищаются от заполнения и книга закрывается с сохранением (чистый шаблон для новой работы).
Макрос:
1. Копирование листа из книги №1 и сохранение его в новой
2. Очистка таблиц на листе в книге №1
3. Закрытие книги №1 с сохранением
Первый и третий пункты выполняются, а второй нет. Посмотрите, пожалуйста, в чём причина. Для теста нужно внести любой текст в А1 (учавствует в имени нового файла), какие-нибуди записи в таблицы, любую цифру в столбце "Стоимость" и нажать на кнопку "Сохранить"
Сохранение листа в новой книге
 
Здравствуйте. В нескольких файлах использовал выложенный код и он работал нормально (разница только, что имя листа брал из Textbox, сейчас из ячейки). В новом файле выдаёт ошибку в строке, в которой присваивается имя листу. Пробовал вместо текста из ячейки вписать конкретный текст, но безрезультатно. Подскажите в чём ошибка
Код
Private Sub СохранитьРасчёт()
 Sheets("Калькуляция").Select
Application.ScreenUpdating = False:
    Dim b
        b = "Калькуляция" 'задаем переменную
CreateObject("Shell.Application").Namespace(ThisWorkbook.Path).NewFolder (b) 'создаем папку
Dim wb1 As Workbook
    Set wb1 = Workbooks.Add 'создаем новую книгу
           With ThisWorkbook.Sheets("Калькуляция") 'выбираем лист для копирования
            .Copy wb1.Sheets(1) 'копируем лист
                Sheets("Калькуляция").Name = Range("A1").Value 'присваиваем листу имя
            wb1.SaveAs Filename:=ThisWorkbook.Path & "\" & b & "\" & "Калькуляция, " & Range("A1").Value & ".xlsx"  'сохраняем нашу книгу со всеми изменениями
         End With
 'удаляем все пустые листы
    Application.DisplayAlerts = False
    Dim sh2 As Worksheet
    For Each sh2 In Sheets
        If IsEmpty(sh2.UsedRange) Then sh2.Delete
    Next
    Application.DisplayAlerts = True
ActiveWorkbook.Save
    wb1.Close 'закрываем новую книгу
    
End Sub
Увеличение размера умной таблицы
 
Здравствуйте. Никак не получается увеличить размер таблицы. Прошу поправить код
Код
Private Sub ДобавитьСтроки_Click()
  Dim myTable As ListObject
 Dim vRetVal
 Dim fcell3 As Variant
 Dim b3 As Variant
 Dim a3 As Variant
Dim c3 As Variant

'Вписываем количество строк, на которые увеличиваем таблицу
vRetVal = InputBox("Укажите количество строк, которые нужно добавить(целое число):", "Вставка новых строк", "")
 c3 = Val(vRetVal)
 
'Поиск заголовка над таблицей
Set fcell3 = Columns("A:A").Find(ИмяПодраздела.Text)
If Not fcell3 Is Nothing Then
Range("A" & fcell3.Row + 2).Select 'активная ячейка для определения по ней имени таблицы
b3 = ActiveCell.ListObject.Name 'ИМЯ ТАБЛИЦЫ

'Определение количества строк в таблице
Set myTable = Worksheets(ИмяРаздела.Text).ListObjects(b3)
'MsgBox myTable.DataBodyRange.Rows.Count
a3 = myTable.DataBodyRange.Rows.Count

ActiveSheet.ListObjects(b3).Range.Resize (a3 + c3)

If StrPtr(vRetVal) = 0 Then
    'MsgBox "Нажата кнопка Отмена. Процедура прервана", vbCritical, "DelCols"
    Exit Sub
End If
End If
End Sub
Определение номера последней таблицы
 
Здравствуйте. Создаю умные таблицы с именами "Таблица1", "Таблица2" и т.д. Нашёл код, который выводит список имён на лист. Как можно выделить из кода только номер последней таблицы или, используя другой метод, сделать это? Цифру буду использовать для номерации следующих таблиц. Сделаю счётчик: счётчик. текст= полученное значение+1
Код
    Dim xTable As ListObject
    Dim xSheet As Worksheet
    Dim I As Long
    I = -1
    Sheets("Настройки").Select
    For Each xSheet In Worksheets
        For Each xTable In xSheet.ListObjects
            I = I + 1
            Sheets("Настройки").Range("C1").Offset(I).Value = xTable.Name
        Next xTable
    Next
Сохранение книги за исключением 1-го листа
 
Здравствуйте. Книга заполнения калькуляции. При окончании работы лист "Калькуляция" сохраняется в новой книге, а файл, в котором работали закрывается без сохранения. В процессе работы возникают моменты, когда нужно не в листе "Калькуляция" сделать изменения (новые цены, ед. изм и т.д.). Хотел на кнопку сделать код, что после внесённых изменений все листы сохраняются за исключением листа "Калькуляция", так как в нём могут быть уже внесённые данные (это до закрытия книги), но найти подходящий не смог. Прошу помочь с кодом
Обращение к ячейкам умной таблицы
 
Здравствуйте. Нашёл код, в котором происхотит поиск текста в умной таблице. Строка найдена - это хорошо, но не могу найти как адресно внести изменения в столбцах этой строки. Нашёл пример:         With ActiveSheet.ListObjects("Таблица1")    
                                                               Debug.Print .Range.Cells(5, 4)
                                                               Debug.Print .ListColumns(4).Range(5)
                                                               Debug.Print .ListRows(4).Range(4)
                                                             End With
но выдаётся ошибка.
Прошу помочь
Код
Private Sub ПоискВТаблице_Click()
Sheets(ИмяРаздела.Text).Select
Dim tbl As ListObject
Dim FoundCell As Range
Dim LookupValue As String
Dim a As Variant

  LookupValue = ИмяФурнитуры.Text
  Set tbl = ActiveSheet.ListObjects(ИмяПодраздела.Text)
  On Error Resume Next
  Set FoundCell = tbl.DataBodyRange.Columns(1).Find(LookupValue, LookAt:=xlWhole)
  On Error GoTo 0
  If Not FoundCell Is Nothing Then
  'если найдено
    MsgBox "Found in table row: " & _
      tbl.ListRows(FoundCell.Row - tbl.HeaderRowRange.Row).Index
      a = tbl.ListRows(FoundCell.Row - tbl.HeaderRowRange.Row).Index
    MsgBox a
    
 'НАЙТИ КОД ОБРАЩЕНИЯ К ЯЧЕЙКЕ ТАБЛИЦЫ ДЛЯ ВВОДА ДАННЫХ
'With ActiveSheet.ListObjects(ИмяФурнитуры.Text)
    'Debug.Print .Range.Cells(3, a).Value = ЦенаЗаЕд.Text
'End With
   
  Else
 'если не найдено
 Call НоваяФурнитура
  End If
End Sub
Ввод текста в Combobox выдаёт ошибку
 
Здравствуйте. При вводе текста в Combobox "ИмяПодраздела" происходят странные вещи. Если текст по-английски, то всё нормально. Если по-русски, то смотря с какой буквы начало текста. Не все буквы проверял, но на "Б" - ошибка, на "П" - нормально. Вообще код должен работать примерно так: проверка на наличие в столбце "А" наименований таблиц (они же входят в заполнение Combobox "ИмяПодраздела"). Если текста, который вносим в Combobox "ИмяПодраздела" поиск не дал положительного ответа, то завершение макроса. Помогите найти ошибку
Код
Private Sub ИмяПодраздела_Change()

'MsgBox Not IsError(Application.Match(ИмяПодраздела.Text, Columns(1), 0))
If IsError(Application.Match(ИмяПодраздела.Text, Columns(1), 0)) = False Then
Exit Sub
Else

'If Columns(1).Find(ИмяПодраздела.Text) Is Nothing Then MsgBox "Нет" Else MsgBox "Да"

'If ИмяПодраздела.Text = "" Then
        'Exit Sub
        'Else
 Dim fcell As Variant
 'Dim a As Variant
Set fcell = Columns("A:A").Find(ИмяПодраздела.Text) 'Поиск имени подраздела в столбце А, находит номер строки
If Not fcell Is Nothing Then
If fcell = "" Then
Exit Sub
Else
'a = Range("A" & fcell.Row).Value 'Наименование таблицы (имя подраздела)
'If a = ИмяРаздела.Text Then
'Exit Sub
'Else



With ActiveSheet.ListObjects(Range("A" & fcell.Row).Value)
    'Обращение через диапазон умной таблицы
Debug.Print .DataBodyRange.Columns(1).Address
ИмяФурнитуры.RowSource = .DataBodyRange.Columns(1).Address 'Заполнение combobox (имя фурнитуры)диапазоном из таблицы
End With
'End If
End If
End If
End If

End Sub
Разбивка имён листов в комбобоксы
 
Здравствуйте. На форме "БазаФурнитуры" есть кнопка, при помощи которой я могу добавить лист с именем, введённым в Combobox "ИмяРаздела". В последствии все имена созданных листов являются заполением Comobox "ИмяРаздела". Всё работает, всё замечательно, но при дальнейшей работе мне нужно стало соэдать формы с именами "БазаМатериала", "БазаРабот", "БазаУслуг". На них тоже есть кнопки для создания листов и комбобоксы, в которые должны входить соответствующие имена листов (кодов на них нет). Помогите с кодом, который будет сортировать имена листов в соответствующий комбобокс (с какой формы создавали лист, в комбобокс этой формы он и входит.
Диапазон умной таблицы для заполнения comobox
 
Здравствуйте. Заполняю Combobox ("ИмяФурнитуры") диапазоном из 1 столбца умной таблицы. Нашёл код, но в Combobox приходит и текст первой строки таблицы ("Наименование"). Как взять диапазон от строки наименований и ниже или взять диапазон из Диспетчера имён (в нём диапазон без строки наименований)? Исправьте пожалуйста код
Код
Private Sub ИмяПодраздела_Change()
If ИмяПодраздела.Text = "" Then
        Exit Sub
        Else
 Dim fcell As Variant
 Dim a As Variant
Set fcell = Columns("A:A").Find(ИмяПодраздела.Text) 'Поиск имени подраздела в столбце А, находит номер строки
If Not fcell Is Nothing Then
a = Range("A" & fcell.Row).Value 'Наименование таблицы (имя подраздела)
With ActiveSheet.ListObjects(a)
    'Обращение через диапазон умной таблицы
Debug.Print .Range.Columns(1).Address
Debug.Print .Range.Columns.Count
ИмяФурнитуры.RowSource = .Range.Columns(1).Address 'Заполнение combobox (имя фурнитуры)диапазоном из таблицы
End With
End If
End If

End Sub
Заполнение листа combobox из диапазона между заголовков
 
Здравствуйте. В Combobox2 выпадающий список состоит из заголовков таблиц на листе (Текст1, Текст2 и.т.д). Combobox1 нужно заполнить данными, расположенными между выбранным текстом в Combobox2 и его следующим текстом (к примеру выбрали Текст2. Combobox1 должен заполниться данными из таблицы от Текста 2 до Текста3). При выборе в Combobox2 к примеру Текст1 - должен очиститься лист Combobox1 от предыдущего заполнения и заполнится данными от Текста1 до Текста2. Я написал код, но заполнение Combobox1 выдаёт ошибку. Прошу проверить её
Заполнение ComboBox из выбираемых ячеек столбца
 
Здравствуйте. На листе может быть бесконечно много однотипных таблиц. В таблицах в первом столбце текст "Наименование". Над "Наименованием" заголовок таблицы. Прошу сделать выборку заголовков и из них заполнение ComboBox на форме. Самому 100% не сделать. Спасибо
Заполнение Combobox из столбца умной таблицы
 
Здравствуйте. Не получается заполнить лист ИмяФурнитуры (Combobox) кнопкой "Войти" из первого столбца таблицы ИмяПодраздела.Text (текст в TextBox). Таблица создаётся с именем из текста в TextBox "ИмяПодраздела", но при вставке в код  ИмяПодраздела.Text - получается ошибка. Если в код вписать "Кухонные" вместо ИмяПодраздела.Text, то код работает. Таблиц предполагается много, поэтому нужно обращаться к имени таблицы. Не могу разобраться, прошу помочь.

Этот код не работает
Код
Dim a()
a = Range("ИмяПодраздела.Text[Наименование]").Value
ИмяФурнитуры.List = a

Этот работает
Код
Dim a()
a = Range("Кухонные[Наименование]").Value
ИмяФурнитуры.List = a
При копировании заголовок вставлять жирным шрифтом
 
Здравствуйте. Я копирую строки с листа ""Lamarty 16 на лист  "Печать" при условии, что в столбце "В" есть значение. Что добавить в код, чтобы заголовок в лист "Печать" копировался жирным шрифтом?  
Копирование строки по условию
 
Здравствуйте. Есть лист с таблицей, в которой нужна проверка на заполенность хотя бы одной ячейки от столбца "B" до столбца "U" в каждой строке. Если есть заполенность, то строка копируется и вставляется на лист "Печать" со второй строки (первая нужна для заголовка). Прошу помочь с макросом
Сравнение диапазонов и определение номера строк отличающихся ячеек
 
Здравствуйте. Сравниваю столбцы I листов Калькуляция и  HiddenSheet на несовпадение. Не могу написать код для определения строк, на которых в столбце I отличаются значения. Нашёл код, переделал его, но не получилось. Прошу помочь. И просьба, чтобы MsgBox в сообщении писал все адреса этих строк. Спасибо  
Разблокировка ячейки в защищённом листе по условию
 
Здравствуйте. Прошу помочь решить вопрос. На защищённом листе в столбце I:I может появиться текст "Нет цены в прайсе", полученный формулой. Если появляется такой текст, то в ячейке G в той же строке разблокируется ячейка. Код срабатывает, если разблокировать лист, встать в строку формул ячейки с текстом  "Нет цены в прайсе" и нажать на Ввод (в этот момент лист снова блокируется макросом). Получается, что для работы макроса нужно какое-то обновление. Что подскажите?
Код
If Target.Cells.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("I:I")) Is Nothing Then
    If Cells(Target.Row, Target.Column) = "Нет цены в прайсе" Then 'Проверка есть ли в столбце I:I текст *Нет цены в прайсе*
        MsgBox "Внесите данные в прайс или впишите стоимость в ячейку " & "G" & Target.Row
     Worksheets("Калькуляция").Range("G" & Target.Row).Locked = False
Worksheets("Калькуляция").Protect
    End If
End If
Макросы навигации на листе
 
Здравствуте. На форме расположены кнопки, макросы которых скрывают ненужное и показывают таблицу, соответстующую кнопке. Пока не добавил в макросы отключение и включение обновления экрана, таблицы были вверху листа, но было видно действие макроса. После отключения и включения обновления экрана стал хаос - некоторые таблицы вверху листа, некоторые внизу листа и, чтобы с ними работать, нужно лифтом поднять вверх. Что сделать, чтобы все таблицы после нажатия на кнопку былы вверху листа?
Доработка макроса раскроя погонажа
 
Здравствуйте. Нашёл файл с макросом, в котором производится раскрой погонных материалов. Просьба внести изменения в код, чтобы результат раскроя можно было регулировать до десятых и целых. В ячейку E1 вписывать точность округления. Некоторый материал можно приобретать не целой штукой, а её частью. Спасибо
Макрос срабатывает 2 раза
 
Здравствуйте. Не могу разобраться. Макрос "НеВыпускают" срабатывает 2 раза. В ячейках I75:I83 значение "не бывает" получено формулой. Для теста этого макроса нужно выбрать в производителе Антарес_38, в категории 3 или 4, или 5, или 6, в наименовании Столешница 4200*600*38. Прошу помочь
Код
Private Sub Worksheet_Calculate()
Call НеВыпускают
End Sub

 Private Sub НеВыпускают()
 Dim a75 As Variant, a76 As Variant, a77 As Variant, a78 As Variant, a79 As Variant, a80 As Variant, a81 As Variant, a82 As Variant, a83 As Variant, a84 As Variant
 Dim b1 As Variant
 a75 = Range("I75").Value
 a76 = Range("I76").Value
 a77 = Range("I77").Value
 a78 = Range("I78").Value
 a79 = Range("I79").Value
 a80 = Range("I80").Value
 a81 = Range("I81").Value
 a82 = Range("I82").Value
 a83 = Range("I83").Value
 a84 = Range("I84").Value
 b1 = "не бывает"
 'Application.EnableEvents = False
    If a75 = b1 Or a76 = b1 Or a77 = b1 Or a78 = b1 Or a79 = b1 Or a80 = b1 Or a81 = b1 Or a82 = b1 Or a83 = b1 Or a84 = b1 Then
    MsgBox "Столешницы в выбранном сочетании не выпускают", vbExclamation, "Категория"
    'Application.EnableEvents = True
    End If
End Sub
При выборе значения ячейки заполняется другая ячейка или получаем MsgBox
 
Здравствуйте.
Идея1:
При выборе из выпадающего списка значений в В75:В83, состоящих из W2:W9 на листе "Вспом" (они же на листе "Калькуляция" К75:К82, но это только для проб), в соседней ячейке  С75:С83 должен появиться текст "нет_категории". Если так:  If Range("B75").Value = "Скиф" Then Range("C75").Value = "нет_категории", то макрос выполняется, но Excel потом зависает, да и макрос будет очень большой, так как нужно перебрать возможный выбор и это повторить для диапазона  В75:В83 - не вариант
Идея2 (альтернативная, но лучше сделать идею1):
Начал делать через MsgBox, убрав появленние в ячейке текста "нет_категории", и вместо него сделал MsgBox с текстом: "В столбце *Категории* выбирайте *нет_категории*", но сообщение в одном макросе выходит второй раз при выборе нужного текста в ячейке столбца С, либо в другом макросе появляется такое количество раз, сколько ячеек заполняем в столбце В.
Я написал кучу макросов, но ни один из них не работает как нужно (на листе 6 (Калькуляция))
Идея3:
И ещё подобный макрос, но отрабатывающий ячейку в столбце I. Если в этой ячейке появляется текст "не бывает" (результат формулы), то MsgBox сообщает:  "Столешницы в выбранном сочетании не выпускают". MsgBox тоже появляется 2 раза. Для теста этого макроса нужно выбрать в производителе Антарес_38, в категории 3 или 4, или 5, или 6, в наименовании Столешница 4200*600*38., макрос Sub НеВыпускают.
Прошу исправть макросы или написать что исправить. Файл прилагаю. Спасибо
Загрузка картинки по размеру объединённых ячеек, но с сохранением пропорций
 
Здравствуйте. Нашёл 2 кода, но оба не соответствуют нужному. При выполнении первого кода картинка может быть значительно меньше размеров объединённых ячеек. При выполнении второго кода картинка по высоте равна высоте объединённых ячеек, но может быть значительно шире. Нужное - это загрузка картинки по размеру объединённых ячеек, но с сохранением пропорций. Прошу исправить код и написать каким пользоваться. Спасибо
Код
Private Sub ОбщийВид_Click() 'Картинка в ячейку A2
  Application.ScreenUpdating = False
     Dim profile As String
    On Error Resume Next
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Picture Files", "*.bmp;*.jpg;*.gif;*.png"
        .ButtonName = "Select"
        .AllowMultiSelect = False
        .Title = "Choose Photo"
        .InitialView = msoFileDialogViewDetails
        .Show
    End With
    With ActiveSheet.Range("A2")
        ActiveSheet.Shapes.AddPicture FileName:=fd.SelectedItems(1), _
            LinkToFile:=msoFalse, _
            SaveWithDocument:=msoCTrue, _
            Left:=.Left - 1, _
            Top:=.Top - 1, _
            Width:=-1, _
            Height:=-1
   Навигация.Изображение.BackColor = vbGreen
    End With
    Application.ScreenUpdating = True
End Sub
Код
Private Sub ДопИзо_Click()  'Картинка по высоте объединённых ячеек H36:M65
  Application.ScreenUpdating = False
    Dim strFullName As String, objShape As Shape
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "Рисунки", "*.jpg"
        If .Show = 0 Then
            Exit Sub
        End If
        strFullName = .SelectedItems(1)
    End With
    Set objShape = ActiveSheet.Shapes.AddPicture(strFullName, False, True, Range("H36").Left, Range("H36").Top, -1, -1)
    objShape.LockAspectRatio = True
    objShape.Height = Range("H36:M65").Height
    Application.ScreenUpdating = True
End Sub
Выбор картинок с сохранением их в созданной папке, сохранение листов книгами
 

Здравствуйте. Просьба помочь в написании кода.

На форме «Замер» кнопка «Выбрать файлы замера». При нажатии на неё выбираем папку с картинками (расширения картинок могут быть разными), переименовываем картинки по именам Заказ.Поле1_9 & «1», Заказ.Поле1_9 & «2» и т.д., создаём папку с именем «Дизайн-проект & Заказ.Поле1_9» рядом с рабочим файлом Excel, в ней создаём папку с именем «Замер & Заказ.Поле1_9» и в неё сохраняем выбранные и переименованные картинки; в Замер. Label2.Caption записываем путь сохранения папки «Дизайн-проект & Заказ.Поле1_9».

На форме «Оформить» кнопка «Оформить и выйти». При нажатии на неё листы «Проект» и «Комплектация» сохраняются отдельными книгами в папку «Дизайн-проект & Заказ.Поле1_9» (путь для неё записан в Замер. Label2.Caption при сохранении картинок).

Заранее спасибо.

Объединение ячеек макросом
 
Здравствуйте. Код работает на заполнение таблицы. Заполненных строк может быть 2 или 3, или 4. Нужно, чтобы провёлся подсчёт заполненных ячеек в столбце "О" в диапазоне работы макроса и столько ячеек объеденились в столбце "N". Я нашёл код по подсчёту заполненных ячеек, переделал под себя, но видимо не правильно, так как постоянно выдаёт, что заполненных ячеек 1. Записал код объединения ячеек, чтобы его переделать, но пока он стоит без доработки, так как для него не могу определить диапазон. Прошу помочь в написании кода объединения ячеек в столбце "N". Код на форме "Навигация". Спасибо
Код
Private Sub ЛДСП1_Проект()

Dim lLastRow As Long
    With Sheets("Проект") 'Работаем на листе Проект
        lLastRow = .Cells(.Rows.count, 15).End(xlUp).Row + 1 'Определение первой свободной ячейки в столбце О
   If Len(Trim(ЛДСП.Выбор1ЛДСПИтог.Caption)) > 0 Then
       .Range("O" & lLastRow) = ЛДСП.Выбор1ЛДСПИтог.Caption 'Наим ЛДСП 1
       .Range("P" & lLastRow) = ЛДСП.Поле1_5.Text  'Приобретение ЛДСП 1
       .Range("Q" & lLastRow) = ЛДСП.Поле1_6.Text  'Обработка ЛДСП 1
       End If
   If Len(Trim(ЛДСП.Выбор1КромкаИтог.Caption)) > 0 Then
       .Range("O" & lLastRow + 1) = ЛДСП.Выбор1КромкаИтог.Caption 'Наим ЛДСП 1 кромка 1
       .Range("P" & lLastRow + 1) = ЛДСП.Поле1_8.Text 'Приобретение ЛДСП 1 кромка 1
       End If
   If Len(Trim(ЛДСП.Выбор1Кромка2Итог.Caption)) > 0 Then
       .Range("O" & lLastRow + 2) = ЛДСП.Выбор1Кромка2Итог.Caption 'Наим ЛДСП 1 кромка 2
       .Range("P" & lLastRow + 2) = ЛДСП.Поле1_10.Text 'Приобретение ЛДСП 1 кромка 2
       End If
   If Len(Trim(ЛДСП.Выбор1Кромка3Итог.Caption)) > 0 Then
       .Range("O" & lLastRow + 3) = ЛДСП.Выбор1Кромка3Итог.Caption 'Наим ЛДСП 1 кромка 3
       .Range("P" & lLastRow + 3) = ЛДСП.Поле1_12.Text 'Приобретение ЛДСП 1 кромка 3
       End If
    .Range("O" & lLastRow).WrapText = True 'включение автопереноса слов
    .Rows(lLastRow).EntireRow.AutoFit 'включение автоподбора высоты строки
    
'Подсчёт заполненных ячеек в массиве
  'Dim x&
'x = WorksheetFunction.CountA(["O" & lLastRow:"O" & lLastRow + 3])
'MsgBox "Заполненных ячеек " & WorksheetFunction.CountA(["O" & lLastRow:"O" & lLastRow + 3]), vbExclamation

       End With
       
 'Объёдинение ячеек
     'Range("N3:N5").Select
    'With Selection
        '.HorizontalAlignment = xlCenter
        '.VerticalAlignment = xlCenter
        '.WrapText = False
        '.Orientation = 0
        '.AddIndent = False
        '.IndentLevel = 0
        '.ShrinkToFit = False
        '.ReadingOrder = xlContext
        '.MergeCells = False
   ' End With
   ' Selection.Merge
       

End Sub
Обновление ComboBox
 
Здравствуйте. На форме "Заказ" находятся комбобоксы и текстбоксы. Рассмотрим работу комбобокса с именем Поле1_8. Список для ComboBox: Поле1_8.List = Лист5.[C2:C10].Value. На форме есть кнопка, которая закрывает форму (Hide), открывает Лист5 для внесения в список изменений или дополнений и на листе размещает кнопку "ИзФирма" для выхода с Листа5 и открывания формы "Заказ" для дальнейшей работы. Если изменения на Лист5 внесены, то они не отображаются в Поле1_8. Если я к кнопке "ИзФирма" добавляю Unload Заказ, то появляется изменённый список, но внесённые данные в текстбоксах пропадают, а мне нужно, чтобы они остались, чтобы можно было дальше заполнять форму с обновлённым комбобоксом. Напишите, пожалйста, код обновления формы или комбобокса, но, чтобы внесённые данные  в других Controls оставались . Спасибо
MsgBox одного макроса мешает работе другого макроса
 

Здравствуйте. Коды работают, но немного между собой конфликтуют. Понимаю, то, что сам написал, то так и работает. Прошу поправить код. Суть вот в чём:

На форме «ЦокольПлинтус» есть несколько рамок (Frame1, Frame3, Frame4, Frame5), в которых находятся поля для проверки их заполнения (TextBox и ComboBox).

1. Конкретно для каждого поля есть код проверки с выдачей MsgBox нужной информации (какое поле не заполнено).

2. Есть код для проверки, если начали заполнять в определённой рамке, но не закончили (есть в некоторых полях данные, а в некоторых нет)

3. Есть код для проверки, что все поля в рамке заполнены, но не нажата кнопка завершения выбора материала (кнопка суммирует с полей всю информацию и она проявляется в Label, расположенном рядом с кнопкой)

4. После заполнения всех полей рамки и нажатой кнопки есть вариант выйти и закрыть форму. Если я это прописываю в коде, то мы выходим и закрываем форму, а для выбора следующего материала, нужно снова открыть форму – не очень удобно. Чтобы это избежать, я сделал MsgBox с 2-мя кнопками Остаться или Выйти.

5. Вот здесь и начинается моя проблема. При незаполненных полях или не нажатой кнопке при выборе следующего материала, выходят сообщения MsgBox из выбора первого материала. Как сделать, чтобы они не выходили?

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

Страницы: 1 2 След.
Наверх