Добрый день! Уважаемые, столкнулся с проблемой: При попытке создания графика отпусков не получается сделать так, чтобы в визуальном представлении начала и окончания отпуска появлялась надпись с датой начала и окончания отпуска. Предполагаю что необходимо использовать логическую функцию ЕСЛИ, только как правильно её применить не соображу. Сам график представляет собой на простом уровне строку, в которой стоят значения дат от 01.01.19 до 31.12.19, соответственно тип ДАТА, данные не влазят в приемлемую длину строки, поэтому ширина выставлена почти в ноль. Извиняюсь за свое косноязычие . На втором листе идёт расчет даты окончания отпуска по формуле: Дата начала отпуска+количество дней отпуска. Соответственно на Листе1 в самом графике продолжительность отпуска отображается фигурными скобками, которые выполнены посредством условного форматирования оператором МЕЖДУ с измененным форматированием по дате начала и окончания. Если кто нибудь знает как можно сделать динамические надписи над соответствующими датами начала/окончания отпуска, а ниже - количество суток отпуска - буду искренне рад и благодарен. Файл в прикрепленном. Готовый график будет естественно выгружен тут же для свободного пользования. Перерыл весь интернет ничего подобного не нашел, лишь далекие попытки сделать это диаграммой, но подобного отображения ими не добился. Спасибо за внимание!
Добрый день! Уважаемые, столкнулся с проблемой: При попытке создания графика отпусков не получается сделать так, чтобы в визуальном представлении начала и окончания отпуска появлялась надпись с датой начала и окончания отпуска. Предполагаю что необходимо использовать логическую функцию ЕСЛИ, только как правильно её применить не соображу. Сам график представляет собой на простом уровне строку, в которой стоят значения дат от 01.01.19 до 31.12.19, соответственно тип ДАТА, данные не влазят в приемлемую длину строки, поэтому ширина выставлена почти в ноль. Извиняюсь за свое косноязычие . На втором листе идёт расчет даты окончания отпуска по формуле: Дата начала отпуска+количество дней отпуска. Соответственно на Листе1 в самом графике продолжительность отпуска отображается фигурными скобками, которые выполнены посредством условного форматирования оператором МЕЖДУ с измененным форматированием по дате начала и окончания. Если кто нибудь знает как можно сделать динамические надписи над соответствующими датами начала/окончания отпуска, а ниже - количество суток отпуска - буду искренне рад и благодарен. Файл в прикрепленном. Готовый график будет естественно выгружен тут же для свободного пользования. Перерыл весь интернет ничего подобного не нашел, лишь далекие попытки сделать это диаграммой, но подобного отображения ими не добился. Спасибо за внимание!Andreykasimus
Посмотрел. Там совсем не то, что в моем примере, взгляните в мой файл. Но все равно спасибо за ответ. В примерах из той темы график дней разбит понедельно, просто каждые 7 дней отображаются, и сделать разбиение по реальным месяцам нельзя. Ведь в какие то дни 30 дней, в другие 31,плюс 28 февраль. Думаю мысль понятна. Ну и подписей рядом с началом и концом отпуска нет. Может есть какие мысли ещё как именно вставить надписи в мой пример?
Посмотрел. Там совсем не то, что в моем примере, взгляните в мой файл. Но все равно спасибо за ответ. В примерах из той темы график дней разбит понедельно, просто каждые 7 дней отображаются, и сделать разбиение по реальным месяцам нельзя. Ведь в какие то дни 30 дней, в другие 31,плюс 28 февраль. Думаю мысль понятна. Ну и подписей рядом с началом и концом отпуска нет. Может есть какие мысли ещё как именно вставить надписи в мой пример?Andreykasimus
Может есть какие мысли ещё как именно вставить надписи в мой пример?
вставить надпись можно вручную (Вставка-Надпись) можно кодом (в примере для первого отпуска) [vba]
Код
Sub TXT_Boxes() arr = Sheets(2).Range("B1:D1").Value otn = arr(1, 1) - #1/1/2019# otk = arr(1, 3) - #1/1/2019# otp = Round(arr(1, 3) - arr(1, 1), 0) / 2 + otn With Sheets(1) add_txt .Cells(10, otn).Top, .Cells(10, otn).Left, Day(arr(1, 1)) add_txt .Cells(10, otk).Top, .Cells(10, otk).Left, Day(arr(1, 3)) add_txt .Cells(13, otp).Top, .Cells(13, otp).Left, arr(1, 3) - arr(1, 1) End With End Sub
Sub add_txt(t, l, d) With Sheets(1).Shapes.AddTextbox(msoTextOrientationHorizontal, l, t, 25, 15) .TextFrame.Characters.Text = d .Fill.Visible = msoFalse .Line.Visible = msoFalse End With End Sub
Может есть какие мысли ещё как именно вставить надписи в мой пример?
вставить надпись можно вручную (Вставка-Надпись) можно кодом (в примере для первого отпуска) [vba]
Код
Sub TXT_Boxes() arr = Sheets(2).Range("B1:D1").Value otn = arr(1, 1) - #1/1/2019# otk = arr(1, 3) - #1/1/2019# otp = Round(arr(1, 3) - arr(1, 1), 0) / 2 + otn With Sheets(1) add_txt .Cells(10, otn).Top, .Cells(10, otn).Left, Day(arr(1, 1)) add_txt .Cells(10, otk).Top, .Cells(10, otk).Left, Day(arr(1, 3)) add_txt .Cells(13, otp).Top, .Cells(13, otp).Left, arr(1, 3) - arr(1, 1) End With End Sub
Sub add_txt(t, l, d) With Sheets(1).Shapes.AddTextbox(msoTextOrientationHorizontal, l, t, 25, 15) .TextFrame.Characters.Text = d .Fill.Visible = msoFalse .Line.Visible = msoFalse End With End Sub
Потрясающе! Вам огромное человеческое искреннее спасибо! Буду теперь разбираться с vba, вчера вечером только нагуглил про vba, но ума дать не смог как с его помощью решить эту задачу) Буду сегодня сидеть построчно пытаться вникнуть в Ваш код, до этого только баловался с qbasic и dark basic. Как закончу и все будет работать именно так как хочу - таблица сразу появится здесь. Конечно дело вкуса, но мне кажется в этом виде она более наглядна и более лаконична по сравнению с другими реализациями. Ещё раз спасибо!
Потрясающе! Вам огромное человеческое искреннее спасибо! Буду теперь разбираться с vba, вчера вечером только нагуглил про vba, но ума дать не смог как с его помощью решить эту задачу) Буду сегодня сидеть построчно пытаться вникнуть в Ваш код, до этого только баловался с qbasic и dark basic. Как закончу и все будет работать именно так как хочу - таблица сразу появится здесь. Конечно дело вкуса, но мне кажется в этом виде она более наглядна и более лаконична по сравнению с другими реализациями. Ещё раз спасибо!Andreykasimus
Еще раз бью челом о твердь, о уважаемые бояре! Неведома мне магия сия, и как не старался вникнуть в суть трудов мужей ученых, так и не явилось просветление в мою гореголовушку.
О большем я и мечтать не мог, но как не обращался к превеликому барину Гуголю он не смог дать ответ на Ваши философские труды: в теле макроса ставлю .Fill.Visible = True, а вот текст подписи выровнять посередине не могу.
Если по-порядку: В Вашем потрясающем макросе в первой строке вы объявляете название процедуры - TXT_Boxes (). вторая строка: объявляете переменную arr которая включает диапазон ячеек B1 и D1 на втором листе, работая со значением. третья строка: определяете переменную otn которой задаете конкретную ячейку диапазона 1, 1 - начало отпуска.(номер дня месяца) четвертая строка: аналогично определяете переменную otk с ячейкой диапазона 1, 3 - конец отпуска пятая строка: определяете переменную otp которой даете округленное значение, которое высчитывается по формуле конец отпуска-начало/2 + начало отпуска. - Я правильно понимаю что это высчитывается положение где будет вставляться Shapes? шестая строка: даете указание что работаете с первым листом седьмая строка: а дальше магия..((
Возможно ли выровнять по высоте (середине) создаваемые надписи, чтобы при активации .Fill.Visible = True они были по центру по высоте? и поменять размер шрифта?
Спасибо за то что откликнулись, это очень ободряет!
Еще раз бью челом о твердь, о уважаемые бояре! Неведома мне магия сия, и как не старался вникнуть в суть трудов мужей ученых, так и не явилось просветление в мою гореголовушку.
О большем я и мечтать не мог, но как не обращался к превеликому барину Гуголю он не смог дать ответ на Ваши философские труды: в теле макроса ставлю .Fill.Visible = True, а вот текст подписи выровнять посередине не могу.
Если по-порядку: В Вашем потрясающем макросе в первой строке вы объявляете название процедуры - TXT_Boxes (). вторая строка: объявляете переменную arr которая включает диапазон ячеек B1 и D1 на втором листе, работая со значением. третья строка: определяете переменную otn которой задаете конкретную ячейку диапазона 1, 1 - начало отпуска.(номер дня месяца) четвертая строка: аналогично определяете переменную otk с ячейкой диапазона 1, 3 - конец отпуска пятая строка: определяете переменную otp которой даете округленное значение, которое высчитывается по формуле конец отпуска-начало/2 + начало отпуска. - Я правильно понимаю что это высчитывается положение где будет вставляться Shapes? шестая строка: даете указание что работаете с первым листом седьмая строка: а дальше магия..((
Возможно ли выровнять по высоте (середине) создаваемые надписи, чтобы при активации .Fill.Visible = True они были по центру по высоте? и поменять размер шрифта?
Спасибо за то что откликнулись, это очень ободряет!Andreykasimus
Возможно ли выровнять по высоте (середине) [...] и поменять размер шрифта?
добавил [vba]
Код
Sub TXT_Boxes() arr = Sheets(2).Range("B1:D1").Value otn = arr(1, 1) - #1/1/2019# otk = arr(1, 3) - #1/1/2019# otp = Round(arr(1, 3) - arr(1, 1), 0) / 2 + otn With Sheets(1) add_txt .Cells(10, otn).Top, .Cells(10, otn).Left, Day(arr(1, 1)) 'вызываем процедуру add_txt и перелаем переменные верхнее левое положение - ячейка в строке 10, столбец otn, надпись - день начала add_txt .Cells(10, otk).Top, .Cells(10, otk).Left, Day(arr(1, 3)) 'вызываем процедуру add_txt и перелаем переменные верхнее левое положение - ячейка в строке 10, столбец otk, надпись - день конца add_txt .Cells(13, otp).Top, .Cells(13, otp).Left, arr(1, 3) - arr(1, 1) 'вызываем процедуру add_txt и перелаем переменные верхнее левое положение - ячейка в строке 13, столбец otp, надпись - продолжительность End With End Sub
Sub add_txt(t, l, d) With Sheets(1).Shapes.AddTextbox(msoTextOrientationHorizontal, l, t, 25, 15) 'вставлям надпись по переменным (направление текста, лево, верх, ширина, высота) .TextFrame.Characters.Text = d 'текст .Fill.Visible = msoFalse 'заливка .Line.Visible = msoFalse 'рамка .TextFrame.Characters.Font.Size = 11 'размер .TextFrame.VerticalAlignment = xlVAlignCenter 'выравнивание по вертикали .TextFrame.HorizontalAlignment = xlHAlignCenter 'выравнивание по горизонтали End With End Sub
Возможно ли выровнять по высоте (середине) [...] и поменять размер шрифта?
добавил [vba]
Код
Sub TXT_Boxes() arr = Sheets(2).Range("B1:D1").Value otn = arr(1, 1) - #1/1/2019# otk = arr(1, 3) - #1/1/2019# otp = Round(arr(1, 3) - arr(1, 1), 0) / 2 + otn With Sheets(1) add_txt .Cells(10, otn).Top, .Cells(10, otn).Left, Day(arr(1, 1)) 'вызываем процедуру add_txt и перелаем переменные верхнее левое положение - ячейка в строке 10, столбец otn, надпись - день начала add_txt .Cells(10, otk).Top, .Cells(10, otk).Left, Day(arr(1, 3)) 'вызываем процедуру add_txt и перелаем переменные верхнее левое положение - ячейка в строке 10, столбец otk, надпись - день конца add_txt .Cells(13, otp).Top, .Cells(13, otp).Left, arr(1, 3) - arr(1, 1) 'вызываем процедуру add_txt и перелаем переменные верхнее левое положение - ячейка в строке 13, столбец otp, надпись - продолжительность End With End Sub
Sub add_txt(t, l, d) With Sheets(1).Shapes.AddTextbox(msoTextOrientationHorizontal, l, t, 25, 15) 'вставлям надпись по переменным (направление текста, лево, верх, ширина, высота) .TextFrame.Characters.Text = d 'текст .Fill.Visible = msoFalse 'заливка .Line.Visible = msoFalse 'рамка .TextFrame.Characters.Font.Size = 11 'размер .TextFrame.VerticalAlignment = xlVAlignCenter 'выравнивание по вертикали .TextFrame.HorizontalAlignment = xlHAlignCenter 'выравнивание по горизонтали End With End Sub
Спасибо! Накачал книг по vba, нужно разобраться в этом самому, правда неудобно просить помощи постоянно. Ваш макрос работает изумительно, спасибо большое за потраченное время! Когда только приступал к графику он казался проще, чем есть на самом деле, причем на порядки)
На днях доделаю на 12 человек график и выложу тут. Еще раз спасибо Вам огромное за макрос, без него я бы точно ничего смог, здоровья Вам и Вашим близким! ЗЫ: Отдельное спасибо за комментарии к коду
Спасибо! Накачал книг по vba, нужно разобраться в этом самому, правда неудобно просить помощи постоянно. Ваш макрос работает изумительно, спасибо большое за потраченное время! Когда только приступал к графику он казался проще, чем есть на самом деле, причем на порядки)
На днях доделаю на 12 человек график и выложу тут. Еще раз спасибо Вам огромное за макрос, без него я бы точно ничего смог, здоровья Вам и Вашим близким! ЗЫ: Отдельное спасибо за комментарии к коду Andreykasimus
На днях доделаю на 12 человек график и выложу тут.
Если Вы сделали таблицу и график, если Вас не затруднит и если у Вас есть на это время – выложите, пожалуйста, на форум в эту тему. До свидания.Никанор
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
.
Спасибо!
