добрый день. в Power Query есть непредсказуемый UsedRange. здесь можно узнать подробнее. хотелось бы сделать этот Range предсказуемым. не могли бы написать макрос, который бы на каждом листе изменял заливку в ячейке А1. выбор адреса только книги или адреса папки всех книг находится в ячейке А1 листа РЕЗУЛЬТАТ. то есть макрос берет адрес из ячейки А1. если там адрес папки, то во всех книгах этой папки на листах надо изменить заливку ячейки А1. если адрес только книги, то заливку изменить только на листах этой книги. как то так. на всякий случай макрорекордером записал замену заливки ячейки А1. в ячейке А3 единицей или нулем можно менять адрес в ячейке А1
Код
Sub aaaa1()
Range("A1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16711679
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Андрей VG, спасибо я сам тоже кое что собрал из того что нашел)
Код
Sub ЗаменаНаВсехЛистахВсехКниг()
Dim Wb As Workbook 'текущая книга ( где исполняемый код)
Dim tWb As Workbook 'открываемая книга
Dim ShtOut As Worksheet 'лист в текущей книге
Dim ShtIn As Worksheet 'лист в открываемом файле
Dim iTempFileName As String 'имя очерёдного открываемого файла
Dim iPath As String 'путь к папке, где лежат все файлы
Dim iNumFiles As Long 'количество открываемых файлов
Dim FD As FileDialog
Dim i As Long
Application.ScreenUpdating = False
iPath = Range("A1").Value
Set Wb = ThisWorkbook 'эта книга
Set ShtOut = Wb.Worksheets("РЕЗУЛЬТАТ")
iNumFiles = 0
On Error GoTo ErrHandler
iTempFileName = Dir(iPath & "*.xlsx")
Do While iTempFileName <> ""
iNumFiles = iNumFiles + 1
Set tWb = Workbooks.Open(Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=False)
'В СтатусБаре отображаем имя открываемого файла
Application.StatusBar = "Обработка файла: " & tWb.Name
ShtOut.Range("A1").Copy
For i = 1 To Sheets.Count
Set ShtIn = tWb.Sheets(i)
ShtIn.Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone
Next i
tWb.Close SaveChanges:=True 'закрыть книгу с сохранением изменений
iTempFileName = Dir 'следующая книга для внесения изменений
Set ShtIn = Nothing 'обнуляем переменную после закрытия книги
Loop
Application.StatusBar = False 'сбрасываем СтатусБар
MsgBox "Изменения произведены в " & iNumFiles & " файлах в папке: " & Chr(10) & iPath, vbInformation, "Конец"
Exit Sub
ErrHandler:
MsgBox "Произошла ошибка!", 48, "Ошибка"
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Sub a2b2c()
Application.ScreenUpdating = False
Sheets("РЕЗУЛЬТАТ").Range("A1").Copy
For i = 1 To Sheets.Count
With Sheets(i)
.Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone
End With
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Sub qq33q()
Dim iPath As String
iPath = Range("A1").Value
If iPath Like "*.xlsm" Then a2b2c Else ЗаменаНаВсехЛистахВсехКниг
End Sub
artyrH написал: я сам тоже кое что собрал из того что нашел)
Артур, да всё у вас не плохо. Я собственно подзадачу разбирал, как определить, что задано в ячейке папка или файл, если имя введено как c:\path\somename
Цитата
RAN написал: А подо что, и с какой закуской потреблять Namespace и иже с ним?
Ну, на русском есть или нет, не знаю. Я обычно тут смотрю Shell object. Правда, в силу асинхронности метода Filter лучше делать так
Код
Dim vCount As Long
'.....
pItems.Filter &H40, "*.xls*"
vCount = pItems.Count
Do While vCount <> pItems.Count
vCount = pItems.Count
Loop
Да, думаю, ты об этом объекте уже читал, его часто упоминают, когда нужно что-то достать из zip архива. Updated. Совсем забыл, что описание есть в классическом месте Объект Shell, причём как требовалось - на русском.