Перейти из форума на сайт.

Новости • Файловые архивы
Поиск • Активные темы • Топ лист
Правила • Кто в on-line?
Вход • Забыли пароль? • Первый раз на этом сайте? • Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Excel VBA (часть 2)

Модерирует : ShIvADeSt

ShIvADeSt (11-01-2010 10:17): http://forum.ru-board.com/topic.cgi?forum=33&topic=10903  Версия для печати • Подписаться • Добавить в закладки
Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200

   

ShIvADeSt



Moderator		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

 
 
Обсуждаем вопросы только по Excel VBA
(программирование макросов, скриптов, пользовательских функций и т.п.).
Приветствуются ссылки на ресурсы и справочную литературу по теме.
 
Вопросы по работе с MS Excel, не относящиеся к программированию, задаем в теме Excel FAQ

 
Обратите внимание, этот топик для помощи в изучении и использовании VBA. Посему запросы типа "Напишите мне такой-то макрос, я VBA не знаю и знать не хочу" не приветствуются.
Древняя мудрость: "Накорми голодного рыбой и он погибнет, научи его ловить рыбу и ты спасешь его."(R)
 
Предыдущие ветки топика: Часть 1
 
Информация общего характера:
  • Список соответствия имен функций в английской и русской версиях Excel
  • Описание Microsoft Excel File Format (eng.)
     
    Рекомендации:
    Если у Вас есть проблема, не решаемая стандартными средствами Excel (об этом можно уточнить здесь) или требующая автоматизации, попробуйте для начала записать макрос самим Excel через меню Сервис (Tools) - Макрос (Macro) - Начать запись (Record New Macro). Подробнее здесь. В большинстве случаев получившийся код (Сервис-Макрос-Макросы-Изменить) Вас не удовлетворит, но подскажет, какие объекты-методы-свойства использовать.  
    Другой Ваш помощник - Просмотр объектов (Object Browser). Ну и встроення помощь (F1), естественно.
     
    Если Вы в тупике, покажите Ваш код (или часть кода) здесь.  Если вылазит ошибка, цитируйте ее полностью. Если код слишком большой, используйте тeг [more].
    Используйте отладчик - Breakpoints (F9), Watches (Shift-F9), Steps (F8 и др.) Сильно облегчает поиск ошибок.
     
    Рекомендуется к прочтению:
  • Первые шаги с Excel VBA
  • Excel VBA: Приёмы программирования
  • WinApi. Лекция из курса "Основы офисного программирования и язык VBA" (для продвинутых)
  • Daily Dose of Excel (eng.) - тематический блог: советы по работе с Excel и прочие материалы
  • Excel Macros & Excel VBA Code Tips, Tricks (eng.) - советы, трюки и уловки
  • Mr. Excel (forum) (eng.) - весьма оживленный форум по Excel&VBA.
  • Приемы, хитрости, трюки и нюансы работы в Microsoft Excel - сайт "Планета Excel", целиком посвященный Excel и всему, что с ним связано.
  • Microsoft Excel: Таблицы и VBA. Справочник. Вопросы и Ответы. Советы. Примеры.  
     
    Родственные топики:
  • Вопросы по работе с MS Excel - Excel FAQ - часть 1, часть 2, часть 3
  • Технические проблемы с MS Office 2003 или Office XP.
  • Word VBA все вопросы по Word VBA туда
  • Access все вопросы по программированию в Access туда
  • Книжульки по VBA - книги по программированию с использованием VBA
     
    Конкретные вопросы:
    Форма-заставка
    Как запустить макрос при изменении положения курсора или значения ячейки
  • Пример 1
  • Пример 2
  • Пример 3 (проверка области)
  • Пример 4
  • Пример 5
    Зацикливание в функции Change или SelectionChange
     
    Ранжирование без пробелов (макрос включает функции сортировки массива и удаления дубликатов, работает и в Excel 2007)
  • под Office 97
     
    Добавление в главное меню своего пункта, ассоциированного с макросом
    Создание ярлыка на рабочем столе
    Снятие защиты листа при забытом пароле
    Смена раскладки клавиатуры
    Скролл формы колесом прокрутки мыши
    Оптимизация кода по быстродействию использованием массивов
    Найти "чужое" окно и нажать в нем кнопку (вписать текст в текстовое поле)
    Работа с UNICODE-символами в VBA: запись, чтение из ячейки, перевод в ASС и обратно
    Как программно подключить дополнительные библиотеки (например, "Microsoft Scripting Runtime" или "Microsoft ActiveX Data Objects 2.8 Library) через References
    • Всего записей: 3956 | Зарегистр. 29-07-2003 | Отправлено: 01:58 23-04-2007 | Исправлено: JekG, 22:32 10-01-2010
    vasiliy74



    Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    привет всем! подскажите пожалуйста цикл по открытию всех файлов в директории с именами следующего формата 03_09_2007.xls, Или просто всех файлов в директории???
     
    ЗЫ: это необходимо для изменения в них нескольких областей данных. открыть изменить закрыть открыть следующий закрыть и т.д. пока вес файлы не переберутся.
    Всего записей: 289 | Зарегистр. 21-02-2006 | Отправлено: 17:58 04-10-2007 | Исправлено: vasiliy74, 18:00 04-10-2007
    Oyger

    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    vasiliy74
     
    Для сканирования файлов можешь использовать следующий цикл:
     
    X="D:\..." 'Твой путь
    File = Dir(X)
    Do While File <> ""
     
        ............
     
        File = Dir
    Loop
     
    На мой взгляд, проще всего запихать все нужные файлы в отдельную папку и "сканировать" ее. Но можешь хранить их и с прочими файлами, но тогда добавь "сортировку" по нужному признаку файла. В твоем случаи, как я понял - по имени.
     
    Добавлено:
    ol7ca
    'Открываем файл без обновления
    Workbooks.Open Filename:="..........", UpdateLinks:=False
    'Отсылаем лист на печать
    Workbooks("......").Sheets("......").PrintOut Copies:=1, Collate:=True
    'Закрываем книгу без сохранения
    Workbooks("......").Close SaveChanges:=False
    Всего записей: 122 | Зарегистр. 22-03-2007 | Отправлено: 21:20 04-10-2007 | Исправлено: Oyger, 21:33 04-10-2007
    Troitsky



    Водник Водкин    		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Olive77

    Цитата:
    Кто ж против будет

    Времени на прилаживание дополнительной функциональности так и не нашлось - с работой завал Чтобы код совсем не завалялся и не плопал без вести, выкладываю пока то, что успел сделать на той неделе. Прошу прощения, даже в надстройку оформить некогда Появится время - код допишу и дооформлю.
     
    Экспорт активной диаграммы в различные графические файлы:
    Код модуля книги
    Код стандартного модуля


    ----------
    Мы в хорошем настроении гуляем по лесам.
    Кто обидеть нас захочет – сам получит по усам.
    Сам полу- получит по усам. Сам полу- получит по усам!
    Всего записей: 795 | Зарегистр. 13-12-2003 | Отправлено: 23:05 04-10-2007 | Исправлено: Troitsky, 23:06 04-10-2007
    invisible17



    Newbie    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Troitsky
     

    Цитата:
    Лучше сначала присвоить переменной ссылку на объект Excel.Application, и только затем пользовать его методы. По окончании освободить ссылки обычным образом

     
    Огромное спасибо!
    Теперь все Ок!
    Всего записей: 3 | Зарегистр. 28-09-2007 | Отправлено: 15:10 05-10-2007
    vasiliy74



    Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Oyger
    File = Dir(X) - это какую смысловую нагрузку несёт? не понял, и алгоритм то же не понял. Воспроизвёл в VBA не чего не получил. в тело цикла желательно для примера поставить например, открытие файла, таким образом можно будет понять работает ли он так как нужно или нет.
    Всего записей: 289 | Зарегистр. 21-02-2006 | Отправлено: 17:18 05-10-2007 | Исправлено: vasiliy74, 17:19 05-10-2007
    ol7ca

    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Oyger
     
    спасибо.
    Всего записей: 125 | Зарегистр. 01-02-2007 | Отправлено: 17:54 05-10-2007
    Oyger

    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    vasiliy74
     
    Держи. Может так понятней?
     
    Dim x as String
    Dim file as string
     
    x = "D:\tmp\" 'Это просто переменная. Вместо "tmp" и диска "d" пропиши свой путь к папке, где исходные файлы. Но путь, если это не корень, закрывай "\"
    file = Dir(x) 'Присваиваем переменной имя первого файла, содержащегося в нужной папке
    Do While file <> "" 'условие - делать цикл до тех пор, пока не "переберутся" все файлы в директории
         
        Workbooks.Open Filename:=x & file 'открываем файл из директории
         
       ............. 'Тут пиши свое "тело"...
     
        Workbooks(file).Close savechanges:=True 'Закрываем файл с сохранением
         
        file = Dir 'Присваеваем переменной имя следующего файла в папке. Переменную "x" уже указывать не надо, а то он начнет "листь" файлы директории с начала
     
    Loop
    Всего записей: 122 | Зарегистр. 22-03-2007 | Отправлено: 18:11 05-10-2007
    vasiliy74



    Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Oyger
    да спасибо ты был прав! я не закрыл директорию \ поэтому имя файла у меня и не присваивалось..
     
    и описание очень подробное всё понятно!
    Всего записей: 289 | Зарегистр. 21-02-2006 | Отправлено: 18:24 05-10-2007 | Исправлено: vasiliy74, 18:25 05-10-2007
    robinLib

    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Организовал Модуль и написал в нем следующую строку:
     
    Sheets("Лист1").Range("a1").Formula = " =ЕСЛИ(B6<>0;1;2)"
     
    При выполнении пишет ошибку "1004 Application defined or object defined error".
     
     
    Что не так?
    Всего записей: 138 | Зарегистр. 24-07-2005 | Отправлено: 21:04 05-10-2007 | Исправлено: robinLib, 21:04 05-10-2007
    AndVGri

    Advanced Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    robinLib
    Используй
    ...Formula = "=IF(B6<>0;1;2)"  
    или
    ...FormulaLocal = "=ЕСЛИ(B6<>0;1;2)"
    Всего записей: 750 | Зарегистр. 14-12-2005 | Отправлено: 04:45 06-10-2007
    SERGE_BLIZNUK

    Silver Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    AndVGri
    только через запятые ;-))
      .Formula = "=IF(B6<>0,1,2)"
    Всего записей: 2014 | Зарегистр. 12-09-2002 | Отправлено: 07:02 06-10-2007
    CEMEH



    Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Вопрос 1
    Может ли VBA работать с картинками?
    в файле 1.jpg сделать надпись.
    Шрифт и место расположения надписи менять в исходном коде.
     
     
    Вопрос 2
    Есть на форме  ТектБокс
    Фон у него белый а шрифт черный.
    Как сделать, что бы после постановки курсора (не мышки, а вертикальной мигающей полоски) на ТекстБокс цвет фона изменился на нем на желтый  
    Всего записей: 237 | Зарегистр. 17-09-2006 | Отправлено: 18:12 06-10-2007 | Исправлено: CEMEH, 23:03 06-10-2007
    Troitsky



    Водник Водкин    		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    CEMEH

    Цитата:
    Может ли VBA работать с картинками?  
    в файле 1.jpg сделать надпись.  
    Шрифт и место расположения надписи менять в исходном коде.

    Смотри, например, в сторону WinAPI GDI
     
     

    Цитата:
    Есть на форме  ТектБокс  
    Фон у него белый а шрифт черный.  
    Как сделать, что бы после постановки курсора (не мышки, а вертикальной мигающей полоски) на ТекстБокс цвет фона изменился на нем на желтый


    Код:
    Private Sub TextBox1_Enter()
      TextBox1.BackColor = vbYellow
    End Sub
     
    Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
      TextBox1.BackColor = vbWhite
    End Sub
    Всего записей: 795 | Зарегистр. 13-12-2003 | Отправлено: 12:32 07-10-2007
    lex79



    Junior Member    		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    all
    Никто не знает как решить задачу со сроком годности на предыдущей странице?
    Всего записей: 85 | Зарегистр. 31-10-2005 | Отправлено: 10:30 08-10-2007
    Dimanish

    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Здравствуйте , если есть желание и возможность помогите пожалуйста решить данную задачку.
    Описание:
    1. Есть рабочие книги вида issue_list*.xls.
    В них в каждой по таблице из двух колонок вида:
    Тестер:   Найденный баг:
    A        описание бага 1
    B        описание бага 2
    C        описание бага 3
    D        описание бага 4
    A        описание бага 5
    D        описание бага 6
    C        описание бага 7
    ....
    ....
    ....
     
    2. Надо "выдрать" из этих issue листов данные в один common_issue_list таким образом:
    Тестер:        Кол-во найденных багов:
    A             x
    B        y
    C        z
    D        ...
    ...
    ...
    ....
    Всего записей: 133 | Зарегистр. 04-02-2005 | Отправлено: 12:29 08-10-2007 | Исправлено: Dimanish, 12:31 08-10-2007
    Oyger

    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    lex79
     
    Не совсем понял, что надо. Так что если не то - уточняй, поправим или сам поправь.
    Шаг 1.
    Открываешь нужную книгу. Затем открываешь окно VBA. В окне "Project Explorer" у Тебя приведен список модулей листов книги и (у меня русская версия) модуль "ЭтаКнига". Открываешь ее код.
    Шаг 2.
    Сверху слева окна кода (где написано General) выбираешь элемент Workbook. У Тебя сразу создаеться процедура:
    Private Sub Workbook_Open()
     
    End Sub
    Вот в ней и будешь писать код
    Шаг 3.
    Пишешь макрос:
     
    Dim X As Byte
     
    X = 2 'Переменная. Вместо "2" - подставь номер столбца, в котором у тебя стоят даты
     
    k = 1 'Номер строки, с которой начинаем проверять даты
     
    Do Until Cells(k, X).Value = Empty 'Условие - делать до первой пустой строки
     
        If Cells(k, X).Value < Date Then 'Если дата в ячейки меньше "СЕГОДНЯ"
            Cells(k, X).Interior.ColorIndex = 38 'То красим ячейку с датой в розовый цвет
        Else
            Cells(k, X).Interior.ColorIndex = 35 'Иначе - в бледно-зеленый
        End If
        k = k + 1
     
    Loop
    Всего записей: 122 | Зарегистр. 22-03-2007 | Отправлено: 14:25 08-10-2007
    lex79



    Junior Member    		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Oyger
    Спасибо. Ты предлагаешь немного другое решение - красить макросом ячейки.
    Я положил на рапиду имеющийся файлик со сроком годности для наглядности. Там уже есть условное форматирование. Нужен макрос, который нажимает последовательно F2 и Enter в ячейках из столбца H, т.е. заставляет обновляться функцию Сегодня(). Возможен ли такой вариант - имитировать нажатие клавиш?
     
    Добавлено:
    Oyger
    Можно ли твоим способом сделать три условия форматирования: если значение в ячейке меньше или равно СЕГОДНЯ(), то ячейка красится в черный, шрифт белый?
    Если значение ячейки меньше или равно СЕГОДНЯ()+7, ячейка красится в красный, шрифт жирный. Если значение ячейки меньше или равно СЕГОДНЯ()+30, ячейка желтая, шрифт жирный.
    В нормальном состоянии (значение ячейки больше СЕГОДНЯ()+30) ячейка светло-зеленая.
    Всего записей: 85 | Зарегистр. 31-10-2005 | Отправлено: 15:15 08-10-2007 | Исправлено: lex79, 17:24 08-10-2007
    Oyger

    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    lex79
     
    Твой файл еще не смотрел - на работе его скачать не могу. А вот "текст" для второй части твоего письма
     
    Dim X As Byte
     
    X = 2  
    k = 1  
    Do Until Cells(k, X).Value = Empty
        With Cells(k, X)
            If Cells(k, X).Value <= Date Then
                .Interior.ColorIndex = 1
                .Font.ColorIndex = 2
                .Font.Bold = False
            End If
            If Cells(k, X).Value > Date And Cells(k, X).Value <= (Date + 7) Then
                .Interior.ColorIndex = 3
                .Font.ColorIndex = 0
                .Font.Bold = True
            End If
            If Cells(k, X).Value > (Date + 7) And Cells(k, X).Value <= (Date + 30) Then
                .Interior.ColorIndex = 6
                .Font.ColorIndex = 0
                .Font.Bold = True
            End If
            If Cells(k, X).Value > (Date + 30) Then
                .Interior.ColorIndex = 35
                .Font.ColorIndex = 0
                .Font.Bold = False
            End If
        End With
        k = k + 1
    Loop
    Всего записей: 122 | Зарегистр. 22-03-2007 | Отправлено: 17:58 08-10-2007
    SERGE_BLIZNUK

    Silver Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    lex79
    1) можно воспользоваться решением от Oyger
    2) а можно и смоделировать то, что Excel воспримет, как обновление значения и перерисует условный формат...

    Код:
     
    Sub UpdateDates()
     Dim ss As Date
     Dim lastrow, i As Integer
     Application.ScreenUpdating = False
     
     lastrow = Cells(ActiveSheet.UsedRange.Rows.Count, "H").End(xlUp).Row
       
     For i = 13 To lastrow
       If (Not IsEmpty(Cells(i, "H"))) And (IsDate(Cells(i, "H"))) Then
         ss = CDate(Cells(i, "H").Value)
         Cells(i, "H").FormulaR1C1 = ss
       End If
     Next i
     
     Application.ScreenUpdating = True
     
    End Sub
     
     

    выполните этот макрос.. если результат понравится, то вообще поместите его на Workbook_Open  
    (как это сделать смотри в сообщении от Oyger)
     
     
    Всего записей: 2014 | Зарегистр. 12-09-2002 | Отправлено: 20:25 08-10-2007 | Исправлено: SERGE_BLIZNUK, 20:32 08-10-2007
    maratino



    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Добрый день!  
    Подскажите пожалуйста  
    есть код  
     
    Private Sub TextBox1_Change()  
    If TextBox1.Text <> "" Then  
        Range("A2").AutoFilter Field:=1, Criteria1:="=" & TextBox1.Text & "*", Operator:=xlAnd  
    Else  
        Range("A2").AutoFilter Field:=1  
    End If  
    End Sub  
     
    Private Sub TextBox2_Change()  
    If TextBox2.Text <> "" Then  
        Range("B2").AutoFilter Field:=2, Criteria1:="=" & TextBox2.Text & "*", Operator:=xlAnd  
    Else  
        Range("B2").AutoFilter Field:=2  
    End If  
    End Sub  
     
    который работает только с текстом  
    как должен выглядеть код для работы с числами, цифрами
    то есть, ввел 2-ку, и все, что начинается  с 2-ки, фильтруются
    Всего записей: 58 | Зарегистр. 11-03-2007 | Отправлено: 23:38 08-10-2007
       

    Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200

    Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Excel VBA (часть 2)
    ShIvADeSt (11-01-2010 10:17): http://forum.ru-board.com/topic.cgi?forum=33&topic=10903


    Реклама на форуме Ru.Board.

    Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
    Modified by Ru.B0ard
    © Ru.B0ard 2000-2024

    BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

    Рейтинг.ru