» Excel VBA (часть 2)

привет всем! подскажите пожалуйста цикл по открытию всех файлов в директории с именами следующего формата 03_09_2007.xls, Или просто всех файлов в директории???

ЗЫ: это необходимо для изменения в них нескольких областей данных. открыть изменить закрыть открыть следующий закрыть и т.д. пока вес файлы не переберутся.

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

Olive77

Цитата:

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

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

Экспорт активной диаграммы в различные графические файлы:
[more=Код модуля книги]
Код: Option Explicit

Private Sub Workbook_Open()

Dim intBarIndex As Variant, i As Integer

' Добавляем кнопку "Экспортировать диаграмму"
' 6 - на панель инструментов "Диаграммы" ("Chart")
' 43 - в контекстное меню "Область построения диаграммы" ("Object/Plot")
' 55 - в контекстное меню "Область диаграммы" ("Plot Area")

intBarIndex = Array(6, 43, 55)

For i = LBound(intBarIndex) To UBound(intBarIndex)
With Application.CommandBars(intBarIndex(i))
.Enabled = True
.Protection = msoBarNoProtection
With .Controls.Add(Type:=msoControlButton, Temporary:=True)
.BeginGroup = True
.OnAction = "ActiveChartExport"
.Caption = "Экспортировать диаграмму"
.FaceId = 2648
End With
End With
Next

End Sub

Troitsky


Цитата:

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

Огромное спасибо!
Теперь все Ок!

Oyger
File = Dir(X) - это какую смысловую нагрузку несёт? не понял, и алгоритм то же не понял. Воспроизвёл в VBA не чего не получил. в тело цикла желательно для примера поставить например, открытие файла, таким образом можно будет понять работает ли он так как нужно или нет.

Oyger

спасибо.

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

Oyger
да спасибо ты был прав! я не закрыл директорию \ поэтому имя файла у меня и не присваивалось..

и описание очень подробное всё понятно!

Организовал Модуль и написал в нем следующую строку:

Sheets("Лист1").Range("a1").Formula = " =ЕСЛИ(B6<>0;1;2)"

При выполнении пишет ошибку "1004 Application defined or object defined error".


Что не так?

robinLib
Используй
...Formula = "=IF(B6<>0;1;2)"
или
...FormulaLocal = "=ЕСЛИ(B6<>0;1;2)"

AndVGri
только через запятые ;-))
.Formula = "=IF(B6<>0,1,2)"

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


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

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

all
Никто не знает как решить задачу со сроком годности на предыдущей странице?

Здравствуйте , если есть желание и возможность помогите пожалуйста решить данную задачку.
Описание:
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        ...
...
...
....

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

Oyger
Спасибо. Ты предлагаешь немного другое решение - красить макросом ячейки.
Я положил на рапиду имеющийся файлик со сроком годности для наглядности. Там уже есть условное форматирование. Нужен макрос, который нажимает последовательно F2 и Enter в ячейках из столбца H, т.е. заставляет обновляться функцию Сегодня(). Возможен ли такой вариант - имитировать нажатие клавиш?

Добавлено:
Oyger
Можно ли твоим способом сделать три условия форматирования: если значение в ячейке меньше или равно СЕГОДНЯ(), то ячейка красится в черный, шрифт белый?
Если значение ячейки меньше или равно СЕГОДНЯ()+7, ячейка красится в красный, шрифт жирный. Если значение ячейки меньше или равно СЕГОДНЯ()+30, ячейка желтая, шрифт жирный.
В нормальном состоянии (значение ячейки больше СЕГОДНЯ()+30) ячейка светло-зеленая.

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

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

Код: [no]
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
[/no]

Добрый день!
Подскажите пожалуйста
есть код

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-ки, фильтруются

PavelO
спасибо большое за помощь

Troitsky

Цитата:

Экспорт активной диаграммы в различные графические файлы:
Код модуля книги [?]
Код стандартного модуля [?]

Здорово

maratino
Выражения наподобие * и ? могут быть использованы только с текстом, а >, <, >=,<= и <> только с числами.

Так что, по-видимому, придется в дополнительном столбце производить преобразование чисел в текст (text(A1,0)).

SERGE_BLIZNUK
Результат понравился, спасибо огромное!!!

может ли кто посоветовать достойные ссылки на литературу по VBA?
ведь то, что есть в оглавлении этой страницы этого не достаточно.
я как-то видел сайт с примерами скрипта для решения общих задач - очень полезная штука!
если кто-то знает что-то подобное - дайте ссылочку также.
было бы хорошо иметь более обширную библиотеку с литературой и примерами.
это уменьшит повторение базовых вопросов.

много вопросов затрагивается в этом топике, но найти нужную информацию нелегко - топик очень большой и требует систематизации.

ol7ca и ALL
Цитата:

я как-то видел сайт с примерами скрипта для решения общих задач - очень полезная штука!

очень рекомендую ознакомится с Хитростями Excel - http://www.planetaexcel.ru/tips.php
даже в шапку сейчас добавлю...

Цитата:

много вопросов затрагивается в этом топике, но найти нужную информацию нелегко - топик очень большой и требует систематизации

тут не поспоришь... мне очень помогает то, что я сохраняю версию для печати на диск и ищу там - а ищу по принципу "помнится что-то такое было..." Но, с другой стороны, здесь есть настоящие Мастера - Гуру владения VBA - они всегда подскажут и помогут! так что - дорогу одолеет идущий...

По поводу литературы: по VBA видел в эл.виде следущие книги:
"Программирование на VBA Учебное пособие. [Е.Н. Горных]"
"Программирование на VBA 2002 [Кузьменко В.Г.]"
"Профессиональное программирование на VBA в Excel 2002 [Уокенбах Джон]"
"Л.А.Демидова, А.Н.Пылькин - Программирование в среде VBA"
"VBA для тех, кто любит думать [Антон Орлов]"
"VBA для `чайников` [Стив Камминг]"
"Программирование в Microsoft Office. Для пользователя"
и на англицком
"John Wiley & Sons - John Walkenbach - Excel 2002 Power Programming with VBA.pdf"

SERGE_BLIZNUK


Цитата:

http://www.planetaexcel.ru/tips.php

я тоже его периодически просматриваю - оч полезный!


Цитата:

По поводу литературы: по VBA видел в эл.виде следущие книги:
"Программирование на VBA Учебное пособие. [Е.Н. Горных]"
"Программирование на VBA 2002 [Кузьменко В.Г.]"
"Профессиональное программирование на VBA в Excel 2002 [Уокенбах Джон]"
"Л.А.Демидова, А.Н.Пылькин - Программирование в среде VBA"
"VBA для тех, кто любит думать [Антон Орлов]"
"VBA для `чайников` [Стив Камминг]"
"Программирование в Microsoft Office. Для пользователя"
и на англицком
"John Wiley & Sons - John Walkenbach - Excel 2002 Power Programming with VBA.pdf"

а есть ли ссылки на эти книги?

Добрый день господа. Я только начал знакомство с вба, не ради праздного любопытства, а из-за интересов работы.
Читаю материал на сайте "первые шаги", там я увидел что можно обращаться к ячейкам используя адресацию r1c1

cell (1,2).select и т.д и т.п

Однако я нигде не могу достать информацию о том каким образом выделить область, используюя такую адресацию. Подскажите пожайлуйста синтаксис.

Допусти мне надо выделить строку от cell (1,1) до cell (1,6).

Заранее примного благодарен.

Ddashevskiy

Range(Cells(1,1),Cells(1,6)).Select

Такая задача: на листе несколько графиков, нужно применить к ним некоторое действие. Причем применять это действие в порядке увеличения свойства Top объектов ChartObject, т.е. начиная с верхней диаграммы на листе и заканчивая нижней. Намекните алгоритм как это сделать.

Sub Удаление_пустых_строк()

Dim r As Integer
Dim c As Integer
Dim h As Variant
Dim flag As Boolean

For r = 1 To 10
For c = 1 To 6
h = Cells(r, c).Value
If Not IsEmpty(h) Then flag = True
Next
If Not flag Then
Rows(r).Select
Selection.Delete Shift:=xlUp
End If
h = Empty
flag = False
Next
End Sub

Подскажите пожайлуйста как это можно было сделать не так "влоб" а с использованием выделения строки?