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

Вход

Регистрация

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

 

= Мир MS Excel/Применить макрос ко всем открытым книгам - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Применить макрос ко всем открытым книгам (Макросы/Sub)
Применить макрос ко всем открытым книгам
Yar4i Дата: Пятница, 10.06.2016, 14:06 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Доброго дня вам.
Столкнулся с необходимостью применить один макрос к нескольким открытым книгам Excel:
[vba]
Код
Sub СохранитьРес()
Rows("7:7").Select
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
a = Split([C7], "*")
For i = Len(a(3)) To 1 Step -1
If Mid$(a(3), i, 1) Like "[!- ,0-9]" Then Exit For   ' с запятой
Next
fn = "Р " & a(0) & ";" & "     " & a(1) & ";" & "     " & Trim$(Mid$(a(3), i + 1))
fn = Replace(fn, """", "")
fn = Replace(fn, "/", ".")
fn = Replace(fn, "*", "х")
ActiveWorkbook.SaveAs fn & ".xlsx", FileFormat:=51
   ' шапку по местам
With Sheets("Локальная ресурсная ведомость")
st = Split(.[C7].Value, "*")
.[C4] = .[C4] & " " & Trim$(st(0))
.[B10] = .[B10] & " " & Trim$(st(1))
.[C6] = Trim$(st(2))
.[C7] = Trim$(st(3))
.[C1] = Trim$(st(4))
.Range("A12:F12").Merge
End With
   ' убрать первую запятую и код стройки из C1 (-4 знака)
With Range("C1")
.Value = Right(.Value, Len(.Value) - 4)
End With
   ' СохрБезЗапроса Макрос
ActiveWindow.SmallScroll Down:=-100
Range("A8").Select
ActiveWindow.View = xlNormalView
ActiveWindow.Zoom = 100
Workbooks.Application.DisplayAlerts = False
Excel.ActiveWorkbook.Save
Application.Quit
Range("A1:H555").Replace " .   (", ".(", xlPart
Range("A1:H555").Replace "   (", " (", xlPart
End Sub
[/vba]
Данный макрос вносит некоторые изменения в документ и сохраняет его с последующим закрытием.
Нигде не встречал макрос применительно к открытым книгам (однолистным).
Фото пяти открытых документов - для наглядности.
К сообщению приложен файл: ResList1.xlsx (13.6 Kb) · 1280002.jpg (77.1 Kb)
 
Ответить
СообщениеДоброго дня вам.
Столкнулся с необходимостью применить один макрос к нескольким открытым книгам Excel:
[vba]
Код
Sub СохранитьРес()
Rows("7:7").Select
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
a = Split([C7], "*")
For i = Len(a(3)) To 1 Step -1
If Mid$(a(3), i, 1) Like "[!- ,0-9]" Then Exit For   ' с запятой
Next
fn = "Р " & a(0) & ";" & "     " & a(1) & ";" & "     " & Trim$(Mid$(a(3), i + 1))
fn = Replace(fn, """", "")
fn = Replace(fn, "/", ".")
fn = Replace(fn, "*", "х")
ActiveWorkbook.SaveAs fn & ".xlsx", FileFormat:=51
   ' шапку по местам
With Sheets("Локальная ресурсная ведомость")
st = Split(.[C7].Value, "*")
.[C4] = .[C4] & " " & Trim$(st(0))
.[B10] = .[B10] & " " & Trim$(st(1))
.[C6] = Trim$(st(2))
.[C7] = Trim$(st(3))
.[C1] = Trim$(st(4))
.Range("A12:F12").Merge
End With
   ' убрать первую запятую и код стройки из C1 (-4 знака)
With Range("C1")
.Value = Right(.Value, Len(.Value) - 4)
End With
   ' СохрБезЗапроса Макрос
ActiveWindow.SmallScroll Down:=-100
Range("A8").Select
ActiveWindow.View = xlNormalView
ActiveWindow.Zoom = 100
Workbooks.Application.DisplayAlerts = False
Excel.ActiveWorkbook.Save
Application.Quit
Range("A1:H555").Replace " .   (", ".(", xlPart
Range("A1:H555").Replace "   (", " (", xlPart
End Sub
[/vba]
Данный макрос вносит некоторые изменения в документ и сохраняет его с последующим закрытием.
Нигде не встречал макрос применительно к открытым книгам (однолистным).
Фото пяти открытых документов - для наглядности.

Автор - Yar4i
Дата добавления - 10.06.2016 в 14:06
_Boroda_ Дата: Пятница, 10.06.2016, 14:34 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Засуньте свой код вовнутрь цикла по открытым книгам (только от селектов избавьтесь)
[vba]
Код
Sub tt()
    For Each Wbn In Workbooks
        With Wbn.Sheets(1)
            'a = .Range("A1")
        End With
    Next
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЗасуньте свой код вовнутрь цикла по открытым книгам (только от селектов избавьтесь)
[vba]
Код
Sub tt()
    For Each Wbn In Workbooks
        With Wbn.Sheets(1)
            'a = .Range("A1")
        End With
    Next
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 10.06.2016 в 14:34
Yar4i Дата: Пятница, 10.06.2016, 15:31 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
от селектов избавьтесь

Спасибо.
Думаю, проверю через недельку, т.к. очень много новых методов услышал.
 
Ответить
Сообщение
от селектов избавьтесь

Спасибо.
Думаю, проверю через недельку, т.к. очень много новых методов услышал.

Автор - Yar4i
Дата добавления - 10.06.2016 в 15:31
Yar4i Дата: Вторник, 07.02.2017, 16:45 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
от селектов избавьтесь

Добрый вечер.
Код немного другой...
Убрал все селекты. Запускал по отдельности - работает код без селектов - т.е. верно убрал.
Ругается на Next предпоследней строчкой.
[vba]
Код
Sub БезСелектов()
For Each Wbn In Workbooks
With Wbn.Sheets(1)
Application.ScreenUpdating = False
'поместить в область печати названия стройки и объекта
Rows("1:1").RowHeight = 45
With Range("C1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
Rows("7:7").RowHeight = 45
With Range("C7")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
End With
'подготовить сохранение   & Trim$(Left$(a(3), 30)) - 20 букв из а3
A = Split([C7], ";")
For i = Len(A(2)) To 1 Step -1
If Mid$(A(2), i, 1) Like "[!- 0-9]" Then Exit For
Next
fn = "Р " & A(0) & ";" & A(1) & ";" & "   " & Trim$(Mid$(A(2), i + 1)) 'сохранение ниже по коду v
'шапку по местам
With Sheets("Локальная ресурсная ведомость")
st = Split(.[C7].Value, ";")
.[B10] = .[B10] & " " & Trim$(st(1))
.[C4] = .[C4] & " " & Trim$(st(0))
.[C7] = Trim$(st(2))
End With
'область печати: вертикаль - последняя строка, горизонталь - восьмой столбец h
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
ActiveSheet.PageSetup.PrintArea = ActiveSheet.Range(Cells(1, 1), Cells(LastRow, 6)).Address
'страничный
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.Zoom = 100
'сохранение
ActiveWorkbook.SaveAs "D:\М29\" & fn & ".xlsx", FileFormat:=51
Application.ScreenUpdating = True
'СохрБезЗапроса Апострофф
ActiveWindow.SmallScroll Down:=-100
With Range("C4")
ActiveWindow.View = xlNormalView
ActiveWindow.Zoom = 100
Workbooks.Application.DisplayAlerts = False
Excel.ActiveWorkbook.Save
Application.Quit
End With
Next 'здесь ругается на ошибку
End Sub
[/vba]
К сообщению приложен файл: -_____5-81-35.xlsx (24.3 Kb)
 
Ответить
Сообщение
от селектов избавьтесь

Добрый вечер.
Код немного другой...
Убрал все селекты. Запускал по отдельности - работает код без селектов - т.е. верно убрал.
Ругается на Next предпоследней строчкой.
[vba]
Код
Sub БезСелектов()
For Each Wbn In Workbooks
With Wbn.Sheets(1)
Application.ScreenUpdating = False
'поместить в область печати названия стройки и объекта
Rows("1:1").RowHeight = 45
With Range("C1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
Rows("7:7").RowHeight = 45
With Range("C7")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
End With
'подготовить сохранение   & Trim$(Left$(a(3), 30)) - 20 букв из а3
A = Split([C7], ";")
For i = Len(A(2)) To 1 Step -1
If Mid$(A(2), i, 1) Like "[!- 0-9]" Then Exit For
Next
fn = "Р " & A(0) & ";" & A(1) & ";" & "   " & Trim$(Mid$(A(2), i + 1)) 'сохранение ниже по коду v
'шапку по местам
With Sheets("Локальная ресурсная ведомость")
st = Split(.[C7].Value, ";")
.[B10] = .[B10] & " " & Trim$(st(1))
.[C4] = .[C4] & " " & Trim$(st(0))
.[C7] = Trim$(st(2))
End With
'область печати: вертикаль - последняя строка, горизонталь - восьмой столбец h
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
ActiveSheet.PageSetup.PrintArea = ActiveSheet.Range(Cells(1, 1), Cells(LastRow, 6)).Address
'страничный
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.Zoom = 100
'сохранение
ActiveWorkbook.SaveAs "D:\М29\" & fn & ".xlsx", FileFormat:=51
Application.ScreenUpdating = True
'СохрБезЗапроса Апострофф
ActiveWindow.SmallScroll Down:=-100
With Range("C4")
ActiveWindow.View = xlNormalView
ActiveWindow.Zoom = 100
Workbooks.Application.DisplayAlerts = False
Excel.ActiveWorkbook.Save
Application.Quit
End With
Next 'здесь ругается на ошибку
End Sub
[/vba]

Автор - Yar4i
Дата добавления - 07.02.2017 в 16:45
Manyasha Дата: Вторник, 07.02.2017, 17:08 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Yar4i, здравствуйте. Привыкайте форматировать код (выделять различные блоки кода отступами). Тогда сразу будет видно, что потеряли и где:
[vba]
Код
Sub БезСелектов()
    For Each Wbn In Workbooks
        With Wbn.Sheets(1)
            Application.ScreenUpdating = False
            'поместить в область печати названия стройки и объекта
            Rows("1:1").RowHeight = 45
            With Range("C1")
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = True
            End With
            Rows("7:7").RowHeight = 45
            With Range("C7")
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlTop
                .WrapText = True
            End With
            'подготовить сохранение   & Trim$(Left$(a(3), 30)) - 20 букв из а3
            A = Split([C7], ";")
            For i = Len(A(2)) To 1 Step -1
                If Mid$(A(2), i, 1) Like "[!- 0-9]" Then Exit For
            Next
            fn = "Р " & A(0) & ";" & A(1) & ";" & "   " & Trim$(Mid$(A(2), i + 1)) 'сохранение ниже по коду v
            'шапку по местам
            With Sheets("Локальная ресурсная ведомость")
                st = Split(.[C7].Value, ";")
                .[B10] = .[B10] & " " & Trim$(st(1))
                .[C4] = .[C4] & " " & Trim$(st(0))
                .[C7] = Trim$(st(2))
            End With
            'область печати: вертикаль - последняя строка, горизонталь - восьмой столбец h
            Dim LastRow As Long
            LastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
            ActiveSheet.PageSetup.PrintArea = ActiveSheet.Range(Cells(1, 1), Cells(LastRow, 6)).Address
            'страничный
            ActiveWindow.View = xlPageBreakPreview
            ActiveWindow.Zoom = 100
            'сохранение
            ActiveWorkbook.SaveAs "D:\М29\" & fn & ".xlsx", FileFormat:=51
            Application.ScreenUpdating = True
            'СохрБезЗапроса Апострофф
            ActiveWindow.SmallScroll Down:=-100
            With Range("C4")
                ActiveWindow.View = xlNormalView
                ActiveWindow.Zoom = 100
                Workbooks.Application.DisplayAlerts = False
                Excel.ActiveWorkbook.Save
                Application.Quit
            End With
        '-----------------------ЧЕГО-ТО НЕ ХВАТАЕТ--------------------
    Next 'здесь ругается на ошибку
End Sub
[/vba]

Блок With Wbn.Sheets(1) не закрыт. Дальше не проверяла.


ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеYar4i, здравствуйте. Привыкайте форматировать код (выделять различные блоки кода отступами). Тогда сразу будет видно, что потеряли и где:
[vba]
Код
Sub БезСелектов()
    For Each Wbn In Workbooks
        With Wbn.Sheets(1)
            Application.ScreenUpdating = False
            'поместить в область печати названия стройки и объекта
            Rows("1:1").RowHeight = 45
            With Range("C1")
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = True
            End With
            Rows("7:7").RowHeight = 45
            With Range("C7")
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlTop
                .WrapText = True
            End With
            'подготовить сохранение   & Trim$(Left$(a(3), 30)) - 20 букв из а3
            A = Split([C7], ";")
            For i = Len(A(2)) To 1 Step -1
                If Mid$(A(2), i, 1) Like "[!- 0-9]" Then Exit For
            Next
            fn = "Р " & A(0) & ";" & A(1) & ";" & "   " & Trim$(Mid$(A(2), i + 1)) 'сохранение ниже по коду v
            'шапку по местам
            With Sheets("Локальная ресурсная ведомость")
                st = Split(.[C7].Value, ";")
                .[B10] = .[B10] & " " & Trim$(st(1))
                .[C4] = .[C4] & " " & Trim$(st(0))
                .[C7] = Trim$(st(2))
            End With
            'область печати: вертикаль - последняя строка, горизонталь - восьмой столбец h
            Dim LastRow As Long
            LastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
            ActiveSheet.PageSetup.PrintArea = ActiveSheet.Range(Cells(1, 1), Cells(LastRow, 6)).Address
            'страничный
            ActiveWindow.View = xlPageBreakPreview
            ActiveWindow.Zoom = 100
            'сохранение
            ActiveWorkbook.SaveAs "D:\М29\" & fn & ".xlsx", FileFormat:=51
            Application.ScreenUpdating = True
            'СохрБезЗапроса Апострофф
            ActiveWindow.SmallScroll Down:=-100
            With Range("C4")
                ActiveWindow.View = xlNormalView
                ActiveWindow.Zoom = 100
                Workbooks.Application.DisplayAlerts = False
                Excel.ActiveWorkbook.Save
                Application.Quit
            End With
        '-----------------------ЧЕГО-ТО НЕ ХВАТАЕТ--------------------
    Next 'здесь ругается на ошибку
End Sub
[/vba]

Блок With Wbn.Sheets(1) не закрыт. Дальше не проверяла.

Автор - Manyasha
Дата добавления - 07.02.2017 в 17:08
Yar4i Дата: Вторник, 07.02.2017, 17:09 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Думал что ругается из-за сохранений - нет.
Сократил код до
[vba]
Код
Sub Короче()
For Each Wbn In Workbooks
With Wbn.Sheets(1)
'поместить в область печати названия стройки и объекта
Rows("1:1").RowHeight = 45
With Range("C1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
Rows("7:7").RowHeight = 45
With Range("C7")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
Next
End Sub
[/vba]
Открыл два документа - не сохраненных.
Запускаю по кнопке на панели быстрого доступа в одном из открытых файлов - в нем делает, а в соседнем ничего не меняет (высоту первой строки)
К сообщению приложен файл: 4172583.jpg (56.1 Kb)


Сообщение отредактировал Yar4i - Вторник, 07.02.2017, 17:11
 
Ответить
СообщениеДумал что ругается из-за сохранений - нет.
Сократил код до
[vba]
Код
Sub Короче()
For Each Wbn In Workbooks
With Wbn.Sheets(1)
'поместить в область печати названия стройки и объекта
Rows("1:1").RowHeight = 45
With Range("C1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
Rows("7:7").RowHeight = 45
With Range("C7")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
Next
End Sub
[/vba]
Открыл два документа - не сохраненных.
Запускаю по кнопке на панели быстрого доступа в одном из открытых файлов - в нем делает, а в соседнем ничего не меняет (высоту первой строки)

Автор - Yar4i
Дата добавления - 07.02.2017 в 17:09
RAN Дата: Вторник, 07.02.2017, 17:22 | Сообщение № 7
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеКак обратиться к диапазону из VBA

Автор - RAN
Дата добавления - 07.02.2017 в 17:22
Yar4i Дата: Вторник, 07.02.2017, 18:01 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Как обратиться к диапазону из VBA

Часа два назад заходил - про привет смотрел.
Если предположить, что код
[vba]
Код
Sub tt()
    For Each Wbn In Workbooks
        With Wbn.Sheets(1)
            'a = .Range("A1")
        End With
    Next
End Sub
[/vba] константа, то
закоментированное тело изменю на правильный пример из ссылки:
[vba]
Код
Range("A1,B10").Value = "Привет"
[/vba] добавить в ячейки A1 и B10 "Привет"
Открываю два файла, запускаю в первом и опять на первом активном "приветы" есть, а на неактивный файл (но открытый) код не отрабатывает.
 
Ответить
Сообщение
Как обратиться к диапазону из VBA

Часа два назад заходил - про привет смотрел.
Если предположить, что код
[vba]
Код
Sub tt()
    For Each Wbn In Workbooks
        With Wbn.Sheets(1)
            'a = .Range("A1")
        End With
    Next
End Sub
[/vba] константа, то
закоментированное тело изменю на правильный пример из ссылки:
[vba]
Код
Range("A1,B10").Value = "Привет"
[/vba] добавить в ячейки A1 и B10 "Привет"
Открываю два файла, запускаю в первом и опять на первом активном "приветы" есть, а на неактивный файл (но открытый) код не отрабатывает.

Автор - Yar4i
Дата добавления - 07.02.2017 в 18:01
Manyasha Дата: Вторник, 07.02.2017, 18:41 | Сообщение № 9
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
правильный пример из ссылки

это неправильный пример. Вы обращаетесь все время к одному и тому же листу.

Найдите в статье фразу
Цитата
По умолчанию для всех диапазонов и ячеек родительским объектом является текущий(активный) лист.

прочитайте внимательно несколько абзацев, начиная с этой фразы. Разберите 2 примера обращения к диапазонам (с активацией листа и без).

Также, разберитесь с конструкцией With.. End With, если Вы с ней еще не знакомы. В справке VBE есть подробное описание, или вот тут на русском: https://msdn.microsoft.com/ru-ru/library/wc500chb.aspx


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение
правильный пример из ссылки

это неправильный пример. Вы обращаетесь все время к одному и тому же листу.

Найдите в статье фразу
Цитата
По умолчанию для всех диапазонов и ячеек родительским объектом является текущий(активный) лист.

прочитайте внимательно несколько абзацев, начиная с этой фразы. Разберите 2 примера обращения к диапазонам (с активацией листа и без).

Также, разберитесь с конструкцией With.. End With, если Вы с ней еще не знакомы. В справке VBE есть подробное описание, или вот тут на русском: https://msdn.microsoft.com/ru-ru/library/wc500chb.aspx

Автор - Manyasha
Дата добавления - 07.02.2017 в 18:41
K-SerJC Дата: Среда, 08.02.2017, 08:35 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 487
Репутация: 86 ±
Замечаний: 0% ±

Excel 2013
Ругается на Next предпоследней строчкой.


next это окончание цикла, цикл вы задаете тут:
[vba]
Код
For Each Wbn In Workbooks
[/vba]

соответственно, должно быть
[vba]
Код
next Wbn
[/vba]


Благими намерениями выстелена дорога в АД.
 
Ответить
Сообщение
Ругается на Next предпоследней строчкой.


next это окончание цикла, цикл вы задаете тут:
[vba]
Код
For Each Wbn In Workbooks
[/vba]

соответственно, должно быть
[vba]
Код
next Wbn
[/vba]

Автор - K-SerJC
Дата добавления - 08.02.2017 в 08:35
Yar4i Дата: Среда, 08.02.2017, 10:44 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
обращаетесь все время к одному и тому же листу

В этом и суть. Стоит мне сохранить книги (допустим на рабочем столе) и назвать их "1.xlsx" и "2.xlsx".
[vba]
Код
Sub M5() и в активной книге [color=red]1[/color] запустить код:
For Each Wbn In Workbooks
With Wbn.Sheets(1)
Workbooks("2.xlsx").Worksheets("Локальная ресурсная ведомость").Range("A1").Value = "Привет"
End With
Next Wbn
End Sub
[/vba]
И "Привет" правильно впишется в неактивную книгу "2.xlsx".
Но я имею дело с несохранёнными открытыми файлами/книгами Excel. И при попытке их сохранить Windows предлагает не длинный вариант, что в шапке записан
"- Локальная ресурсная ведомость по форме №5 (МДС81-35.2004)1.xlsx"
"- Локальная ресурсная ведомость по форме №5 (МДС81-35.2004)2.xlsx" и т.д.,
а немного короче:
"- Локальная ресурсная ведомость по форме №5 (МДС81-35.xlsx" и при сохранении последующего файла "2" затирает первый и присваивает ему это же имя.
В предыдущем коде (Вторник, 07.02.2017, 16:45 | Сообщение № 4) идёт присвоение имени файлам, но имена присваиваются всегда разные. Отсюда выход.
Предварительно присвоить временные имена файлам "1", "2"... и далее по коду ссылаться на эти временные имена файлов и после переименовывать в постоянные.
Или поочередно активировать каждый лист - лист он же активируется при проигрывании кода по закрытию файлов без каких-либо запросов.
К сообщению приложен файл: 6330469.jpg (39.2 Kb)
 
Ответить
Сообщение
обращаетесь все время к одному и тому же листу

В этом и суть. Стоит мне сохранить книги (допустим на рабочем столе) и назвать их "1.xlsx" и "2.xlsx".
[vba]
Код
Sub M5() и в активной книге [color=red]1[/color] запустить код:
For Each Wbn In Workbooks
With Wbn.Sheets(1)
Workbooks("2.xlsx").Worksheets("Локальная ресурсная ведомость").Range("A1").Value = "Привет"
End With
Next Wbn
End Sub
[/vba]
И "Привет" правильно впишется в неактивную книгу "2.xlsx".
Но я имею дело с несохранёнными открытыми файлами/книгами Excel. И при попытке их сохранить Windows предлагает не длинный вариант, что в шапке записан
"- Локальная ресурсная ведомость по форме №5 (МДС81-35.2004)1.xlsx"
"- Локальная ресурсная ведомость по форме №5 (МДС81-35.2004)2.xlsx" и т.д.,
а немного короче:
"- Локальная ресурсная ведомость по форме №5 (МДС81-35.xlsx" и при сохранении последующего файла "2" затирает первый и присваивает ему это же имя.
В предыдущем коде (Вторник, 07.02.2017, 16:45 | Сообщение № 4) идёт присвоение имени файлам, но имена присваиваются всегда разные. Отсюда выход.
Предварительно присвоить временные имена файлам "1", "2"... и далее по коду ссылаться на эти временные имена файлов и после переименовывать в постоянные.
Или поочередно активировать каждый лист - лист он же активируется при проигрывании кода по закрытию файлов без каких-либо запросов.

Автор - Yar4i
Дата добавления - 08.02.2017 в 10:44
Pelena Дата: Среда, 08.02.2017, 10:48 | Сообщение № 12
Группа: Админы
Ранг: Местный житель
Сообщений: 19158
Репутация: 4411 ±
Замечаний: ±

Excel 365 & Mac Excel
изменю на правильный пример

правильный пример будет
[vba]
Код
.Range("A1,B10").Value = "Привет"
[/vba]
Говорю прямым текстом, потому что по ссылкам Вы не ходите и справку не читаете


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
изменю на правильный пример

правильный пример будет
[vba]
Код
.Range("A1,B10").Value = "Привет"
[/vba]
Говорю прямым текстом, потому что по ссылкам Вы не ходите и справку не читаете

Автор - Pelena
Дата добавления - 08.02.2017 в 10:48
Yar4i Дата: Среда, 08.02.2017, 11:20 | Сообщение № 13
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
прямым текстом

Вот и я думаю, от селектов избавились, а потом к именам вернулись - не может этого быть и ещё сбивало множественное число "РабочихКниг" в шапке кода [vba]
Код
For Each Wbn In Workbooks
[/vba]
Спасибо.
 
Ответить
Сообщение
прямым текстом

Вот и я думаю, от селектов избавились, а потом к именам вернулись - не может этого быть и ещё сбивало множественное число "РабочихКниг" в шапке кода [vba]
Код
For Each Wbn In Workbooks
[/vba]
Спасибо.

Автор - Yar4i
Дата добавления - 08.02.2017 в 11:20
Yar4i Дата: Среда, 08.02.2017, 11:41 | Сообщение № 14
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
И опять... на предварительно сохраненных "Привет" вставляется, а на не сохраненных файлах, только на первом/активном срабатывает.
При проигрывании макроса с сохранением выскакивает табличка с "Debug", но просмотреть ошибку не дает - всё сворачивается, кроме оставшихся несохраненных файлов и в них опять эта же ошибка.
Значит код не учитывает не сохраненные файлы.
[vba]
Код
Sub Рес5()
    For Each Wbn In Workbooks
        With Wbn.Sheets(1)
        'подготовить сохранение
        A = Split([C7], ";")
        For i = Len(A(2)) To 1 Step -1
        If Mid$(A(2), i, 1) Like "[!- 0-9]" Then Exit For
        Next
        fn = "Р " & A(0) & ";" & A(1) & ";" & "   " & Trim$(Mid$(A(2), i + 1))
        ActiveWorkbook.SaveAs "D:\М29\" & fn & ".xlsx", FileFormat:=51
        Application.ScreenUpdating = True
        'СохрБезЗапроса Апострофф
        ActiveWindow.SmallScroll Down:=-100
            With Range("C4")
            ActiveWindow.View = xlNormalView
            ActiveWindow.Zoom = 100
            Workbooks.Application.DisplayAlerts = False
            Excel.ActiveWorkbook.Save
            Application.Quit
            End With
        End With
    Next Wbn
End Sub
[/vba]
Уже упростил и нигде не цепляюсь за названия и константы...


Сообщение отредактировал Yar4i - Среда, 08.02.2017, 11:51
 
Ответить
СообщениеИ опять... на предварительно сохраненных "Привет" вставляется, а на не сохраненных файлах, только на первом/активном срабатывает.
При проигрывании макроса с сохранением выскакивает табличка с "Debug", но просмотреть ошибку не дает - всё сворачивается, кроме оставшихся несохраненных файлов и в них опять эта же ошибка.
Значит код не учитывает не сохраненные файлы.
[vba]
Код
Sub Рес5()
    For Each Wbn In Workbooks
        With Wbn.Sheets(1)
        'подготовить сохранение
        A = Split([C7], ";")
        For i = Len(A(2)) To 1 Step -1
        If Mid$(A(2), i, 1) Like "[!- 0-9]" Then Exit For
        Next
        fn = "Р " & A(0) & ";" & A(1) & ";" & "   " & Trim$(Mid$(A(2), i + 1))
        ActiveWorkbook.SaveAs "D:\М29\" & fn & ".xlsx", FileFormat:=51
        Application.ScreenUpdating = True
        'СохрБезЗапроса Апострофф
        ActiveWindow.SmallScroll Down:=-100
            With Range("C4")
            ActiveWindow.View = xlNormalView
            ActiveWindow.Zoom = 100
            Workbooks.Application.DisplayAlerts = False
            Excel.ActiveWorkbook.Save
            Application.Quit
            End With
        End With
    Next Wbn
End Sub
[/vba]
Уже упростил и нигде не цепляюсь за названия и константы...

Автор - Yar4i
Дата добавления - 08.02.2017 в 11:41
Yar4i Дата: Среда, 08.02.2017, 14:15 | Сообщение № 15
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
А может виноват (Режим совместимости)?
Ведь вы код проверяете на уже сохраненных файлах. Вы скачиваете и открываете. У меня же программа экспортирует в Excel и сразу их открывает (не сохраняя) присваивая стандартное имя и добавляя в конце 1,2,3 и т.д.
 
Ответить
СообщениеА может виноват (Режим совместимости)?
Ведь вы код проверяете на уже сохраненных файлах. Вы скачиваете и открываете. У меня же программа экспортирует в Excel и сразу их открывает (не сохраняя) присваивая стандартное имя и добавляя в конце 1,2,3 и т.д.

Автор - Yar4i
Дата добавления - 08.02.2017 в 14:15
RAN Дата: Среда, 08.02.2017, 14:58 | Сообщение № 16
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
А может все-же в прокладке?
О какой следующей книге может быть речь при закрытом Excel?
[vba]
Код
Application.Quit
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеА может все-же в прокладке?
О какой следующей книге может быть речь при закрытом Excel?
[vba]
Код
Application.Quit
[/vba]

Автор - RAN
Дата добавления - 08.02.2017 в 14:58
Yar4i Дата: Среда, 08.02.2017, 15:23 | Сообщение № 17
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
при закрытом Excel?

да, спасибо. И я нашел у себя лишнее сохранение [vba]
Код
Excel.ActiveWorkbook.Save
[/vba]
Порывшись ещё я обнаружил странность с этими несохраненными файлами. Одни люди говорили у них всё выходит, а другие уверяли в обратном. Я попробовал разные файлы (и тех и иных людей) и могу сказать они все правы.
Пуск-Все программы-Microsoft Office 2013-Excel 2013) открываю три файла.
Запускаю код
[vba]
Код
Sub Р5()
    Dim wb As Workbook
      For Each wb In Workbooks
      If Len(wb.Path) = 0 Then wb.SaveAs strPath & wb.Name
    Next wb
End Sub
[/vba] и все три файла под именами Книга1,2,3... сохраняются в Мои документы.
А стоит мне экспортировать другие файлы из программы - также не сохранённые (приложил их) - всё, макрос не срабатывает. И сохраняет лишь один файл в непонятном расширении.
К сообщению приложен файл: -_____5-81-351.xlsx (15.9 Kb) · -_____5-81-352.xlsx (24.3 Kb)


Сообщение отредактировал Yar4i - Среда, 08.02.2017, 15:24
 
Ответить
Сообщение
при закрытом Excel?

да, спасибо. И я нашел у себя лишнее сохранение [vba]
Код
Excel.ActiveWorkbook.Save
[/vba]
Порывшись ещё я обнаружил странность с этими несохраненными файлами. Одни люди говорили у них всё выходит, а другие уверяли в обратном. Я попробовал разные файлы (и тех и иных людей) и могу сказать они все правы.
Пуск-Все программы-Microsoft Office 2013-Excel 2013) открываю три файла.
Запускаю код
[vba]
Код
Sub Р5()
    Dim wb As Workbook
      For Each wb In Workbooks
      If Len(wb.Path) = 0 Then wb.SaveAs strPath & wb.Name
    Next wb
End Sub
[/vba] и все три файла под именами Книга1,2,3... сохраняются в Мои документы.
А стоит мне экспортировать другие файлы из программы - также не сохранённые (приложил их) - всё, макрос не срабатывает. И сохраняет лишь один файл в непонятном расширении.

Автор - Yar4i
Дата добавления - 08.02.2017 в 15:23
K-SerJC Дата: Среда, 08.02.2017, 16:41 | Сообщение № 18
Группа: Проверенные
Ранг: Обитатель
Сообщений: 487
Репутация: 86 ±
Замечаний: 0% ±

Excel 2013
Запускаю код

а где в этом коде вы strPath задаете?
может так надо? если запускаете макрос из сохраненной книги.
[vba]
Код


Sub Р5()
    Dim wb As Workbook, strPath
    strPath=ActiveWorkbook.Path
    For Each wb In Workbooks
    If Len(wb.Path) = 0 Then wb.SaveAs strPath & wb.Name
    Next wb
End Sub
[/vba]

или жестко прописать путь
[vba]
Код
strPath="С:/temp/"
[/vba]

пользуйтесь для отладки кода дебагером?
можно поставить стоп-метки, и в пошаговом режиме поверить текущие значения переменных
выделяете переменную, правой мышкой, выбираете Add Wath затем в окне wathes смотрите значения при выполнении


Благими намерениями выстелена дорога в АД.

Сообщение отредактировал K-SerJC - Среда, 08.02.2017, 16:49
 
Ответить
Сообщение
Запускаю код

а где в этом коде вы strPath задаете?
может так надо? если запускаете макрос из сохраненной книги.
[vba]
Код


Sub Р5()
    Dim wb As Workbook, strPath
    strPath=ActiveWorkbook.Path
    For Each wb In Workbooks
    If Len(wb.Path) = 0 Then wb.SaveAs strPath & wb.Name
    Next wb
End Sub
[/vba]

или жестко прописать путь
[vba]
Код
strPath="С:/temp/"
[/vba]

пользуйтесь для отладки кода дебагером?
можно поставить стоп-метки, и в пошаговом режиме поверить текущие значения переменных
выделяете переменную, правой мышкой, выбираете Add Wath затем в окне wathes смотрите значения при выполнении

Автор - K-SerJC
Дата добавления - 08.02.2017 в 16:41
Yar4i Дата: Среда, 08.02.2017, 17:10 | Сообщение № 19
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
пользуйтесь для отладки кода дебагером?

этот вопрос и был задан здесь
Debug.Print не прописывал в коде, но всегда Debug жму и исправляю после не завершенного проигрывания макроса.

ой [vba]
Код
Dim strPath$
[/vba] не прописал


Сообщение отредактировал Yar4i - Среда, 08.02.2017, 17:13
 
Ответить
Сообщение
пользуйтесь для отладки кода дебагером?

этот вопрос и был задан здесь
Debug.Print не прописывал в коде, но всегда Debug жму и исправляю после не завершенного проигрывания макроса.

ой [vba]
Код
Dim strPath$
[/vba] не прописал

Автор - Yar4i
Дата добавления - 08.02.2017 в 17:10
Yar4i Дата: Среда, 08.02.2017, 17:30 | Сообщение № 20
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
[vba]
Код
Sub Р5()
    Dim wb As Workbook, strPath
    strPath=ActiveWorkbook.Path
    For Each wb In Workbooks
    If Len(wb.Path) = 0 Then wb.SaveAs strPath & wb.Name
    Next wb
End Sub
[/vba]

этот код работает с вновь созданными книгами, но не работает с экспортированными файлами из программы.


Сообщение отредактировал Yar4i - Среда, 08.02.2017, 17:31
 
Ответить
Сообщение
[vba]
Код
Sub Р5()
    Dim wb As Workbook, strPath
    strPath=ActiveWorkbook.Path
    For Each wb In Workbooks
    If Len(wb.Path) = 0 Then wb.SaveAs strPath & wb.Name
    Next wb
End Sub
[/vba]

этот код работает с вновь созданными книгами, но не работает с экспортированными файлами из программы.

Автор - Yar4i
Дата добавления - 08.02.2017 в 17:30
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Применить макрос ко всем открытым книгам (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

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