Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Доработка кода модификации календаря JP_Сalendar - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Доработка кода модификации календаря JP_Сalendar (Макросы/Sub)
Доработка кода модификации календаря JP_Сalendar
Otter Дата: Суббота, 25.04.2015, 11:03 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019, Word 2019
Всем доброго здоровья.
Есть в готовом Решении JP_Сalendar доработка календаря с кнопкой вывода месяца. Как доработать, чтобы выводился месяц с автоподбором ширины столбцов и выглядел компактно как на картинке в приложении.
Файл из указанной темы, который надо подправить тоже прикреплен к сообщению. Можно написать код, который надо вставить в макрос.
Спасибо за внимание и тому кто откликнется.
К сообщению приложен файл: JP_Calendar_R-2.rar (45.3 Kb) · 4722547.jpg (13.1 Kb)
 
Ответить
СообщениеВсем доброго здоровья.
Есть в готовом Решении JP_Сalendar доработка календаря с кнопкой вывода месяца. Как доработать, чтобы выводился месяц с автоподбором ширины столбцов и выглядел компактно как на картинке в приложении.
Файл из указанной темы, который надо подправить тоже прикреплен к сообщению. Можно написать код, который надо вставить в макрос.
Спасибо за внимание и тому кто откликнется.
Автор - Otter
Дата добавления - 25.04.2015 в 11:03
nilem Дата: Суббота, 25.04.2015, 11:47 | Сообщение № 2
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
Otter, привет
можно одну строку закомментировать, и две - добавить
[vba]
Код
Private Sub CmbSheet_Click()
Dim arr(1 To 8, 1 To 7), i&, j&
If TypeName(Selection) <> "Range" Then Exit Sub
'arr(1, 4) = cmbx_Month.Text & "  " & txbx_Year.Text
arr(2, 1) = "Пн": arr(2, 2) = "Вт": arr(2, 3) = "Ср": arr(2, 4) = "Чт"
arr(2, 5) = "Пт": arr(2, 6) = "Сб": arr(2, 7) = "Вс"
For i = 3 To 8    ' по строкам
     For j = 1 To 7    ' по ячейкам строк (по столбцам)
         With Me.Controls("Cell_" & i - 2 & "_" & j)
             arr(i, j) = .Caption
         End With
     Next j
Next i
With Selection(1)
     .Resize(8, 7) = arr
     .Resize(, 7).EntireColumn.AutoFit '****
     .Item(1, 4).Value = cmbx_Month.Text & "  " & txbx_Year.Text '****
     .Resize(8, 7).HorizontalAlignment = xlCenter
     .Resize(8, 7).VerticalAlignment = xlCenter
     .Resize(1, 7).Font.Bold = True
     .Resize(1, 7).Interior.Color = 5296274
     .Offset(1).Resize(1, 7).Font.Bold = True
     .Offset(1).Resize(1, 7).Interior.Color = 14211288
     .Offset(1, 5).Resize(7, 2).Font.Color = vbRed
End With
End Sub
[/vba]

Яндекс.Деньги 4100159601573
 
Ответить
СообщениеOtter, привет
можно одну строку закомментировать, и две - добавить
[vba]
Код
Private Sub CmbSheet_Click()
Dim arr(1 To 8, 1 To 7), i&, j&
If TypeName(Selection) <> "Range" Then Exit Sub
'arr(1, 4) = cmbx_Month.Text & "  " & txbx_Year.Text
arr(2, 1) = "Пн": arr(2, 2) = "Вт": arr(2, 3) = "Ср": arr(2, 4) = "Чт"
arr(2, 5) = "Пт": arr(2, 6) = "Сб": arr(2, 7) = "Вс"
For i = 3 To 8    ' по строкам
     For j = 1 To 7    ' по ячейкам строк (по столбцам)
         With Me.Controls("Cell_" & i - 2 & "_" & j)
             arr(i, j) = .Caption
         End With
     Next j
Next i
With Selection(1)
     .Resize(8, 7) = arr
     .Resize(, 7).EntireColumn.AutoFit '****
     .Item(1, 4).Value = cmbx_Month.Text & "  " & txbx_Year.Text '****
     .Resize(8, 7).HorizontalAlignment = xlCenter
     .Resize(8, 7).VerticalAlignment = xlCenter
     .Resize(1, 7).Font.Bold = True
     .Resize(1, 7).Interior.Color = 5296274
     .Offset(1).Resize(1, 7).Font.Bold = True
     .Offset(1).Resize(1, 7).Interior.Color = 14211288
     .Offset(1, 5).Resize(7, 2).Font.Color = vbRed
End With
End Sub
[/vba]
Автор - nilem
Дата добавления - 25.04.2015 в 11:47
Otter Дата: Суббота, 25.04.2015, 12:58 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019, Word 2019
Спасибо. работает. Только на один месяц а если второй поставить?
Оопс :( . После ввода второго месяца получаем вот что. Как это исправить.
К сообщению приложен файл: 2165051.jpg (28.1 Kb)


Сообщение отредактировал Otter - Суббота, 25.04.2015, 13:24
 
Ответить
СообщениеСпасибо. работает. Только на один месяц а если второй поставить?
Оопс :( . После ввода второго месяца получаем вот что. Как это исправить.
Автор - Otter
Дата добавления - 25.04.2015 в 12:58
KSV Дата: Суббота, 25.04.2015, 16:43 | Сообщение № 4
Группа: Друзья
Ранг: Ветеран
Сообщений: 770
Репутация: 255 ±
Замечаний: 0% ±

Excel 2013
можно так:
[vba]
Код
Private Sub CmbSheet_Click()
     Dim arr(1 To 8, 1 To 7), i&, j&
     If TypeName(Selection) <> "Range" Then Exit Sub
     arr(1, 1) = cmbx_Month.Text & "  " & txbx_Year.Text
     arr(2, 1) = "Пн": arr(2, 2) = "Вт": arr(2, 3) = "Ср": arr(2, 4) = "Чт"
     arr(2, 5) = "Пт": arr(2, 6) = "Сб": arr(2, 7) = "Вс"
     For i = 3 To 8   ' по строкам
         For j = 1 To 7   ' по ячейкам строк (по столбцам)
             With Me.Controls("Cell_" & i - 2 & "_" & j)
                 arr(i, j) = .Caption
             End With
         Next j
     Next i
     With Selection(1)
         .Font.Bold = True
         .Interior.Color = 5296274
         With .Resize(8, 7)
             .Value = arr
             .HorizontalAlignment = xlCenter
             .VerticalAlignment = xlCenter
             .Rows(1).Merge
             With .Rows(2)
                 .Font.Bold = True
                 .Interior.Color = 14211288
             End With
             .Columns(6).Resize(, 2).Font.Color = vbRed
             .EntireColumn.AutoFit
         End With
     End With
End Sub
[/vba]

KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333

Сообщение отредактировал KSV - Суббота, 25.04.2015, 16:46
 
Ответить
Сообщениеможно так:
[vba]
Код
Private Sub CmbSheet_Click()
     Dim arr(1 To 8, 1 To 7), i&, j&
     If TypeName(Selection) <> "Range" Then Exit Sub
     arr(1, 1) = cmbx_Month.Text & "  " & txbx_Year.Text
     arr(2, 1) = "Пн": arr(2, 2) = "Вт": arr(2, 3) = "Ср": arr(2, 4) = "Чт"
     arr(2, 5) = "Пт": arr(2, 6) = "Сб": arr(2, 7) = "Вс"
     For i = 3 To 8   ' по строкам
         For j = 1 To 7   ' по ячейкам строк (по столбцам)
             With Me.Controls("Cell_" & i - 2 & "_" & j)
                 arr(i, j) = .Caption
             End With
         Next j
     Next i
     With Selection(1)
         .Font.Bold = True
         .Interior.Color = 5296274
         With .Resize(8, 7)
             .Value = arr
             .HorizontalAlignment = xlCenter
             .VerticalAlignment = xlCenter
             .Rows(1).Merge
             With .Rows(2)
                 .Font.Bold = True
                 .Interior.Color = 14211288
             End With
             .Columns(6).Resize(, 2).Font.Color = vbRed
             .EntireColumn.AutoFit
         End With
     End With
End Sub
[/vba]
Автор - KSV
Дата добавления - 25.04.2015 в 16:43
Otter Дата: Суббота, 25.04.2015, 17:31 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019, Word 2019
Да так нормально. Спасибо за труды.
 
Ответить
СообщениеДа так нормально. Спасибо за труды.
Автор - Otter
Дата добавления - 25.04.2015 в 17:31
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Доработка кода модификации календаря JP_Сalendar (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!