Применить макрос ко всем открытым книгам

Старая форма входа

Страница 1 из 2 1 2 »
Модератор форума: китин, _Boroda_

Применить макрос ко всем открытым книгам (Макросы/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]

Код

Автор - Yar4i
Дата добавления - 10.06.2016 в 14:06

_Boroda_

Дата: Пятница, 10.06.2016, 14:34 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 16709

Репутация: 6501 ±

Замечаний: ±

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

Ответить

Yar4i

Дата: Пятница, 10.06.2016, 15:31 | Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 137

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата _Boroda_, 10.06.2016 в 14:34, в сообщении № 2

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

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

Ответить

Yar4i

Дата: Вторник, 07.02.2017, 16:45 | Сообщение № 4

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 137

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата _Boroda_, 10.06.2016 в 14:34, в сообщении № 2 ()

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

Добрый вечер.
Код немного другой...
Убрал все селекты. Запускал по отдельности - работает код без селектов - т.е. верно убрал.
Ругается на 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]

Цитата _Boroda_, 10.06.2016 в 14:34, в сообщении № 2 ()

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

Код

[/vba]Yar4i

К сообщению приложен файл: -_____5-81-35.xlsx (24.3 Kb)

Ответить

Сообщение

Цитата _Boroda_, 10.06.2016 в 14:34, в сообщении № 2 ()

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

Код

[/vba]

Автор - Yar4i
Дата добавления - 07.02.2017 в 16:45

Manyasha

Дата: Вторник, 07.02.2017, 17:08 | Сообщение № 5

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 901 ±

Замечаний: 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) не закрыт. Дальше не проверяла.

Код

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

ЯД: 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

Ответить

RAN

Дата: Вторник, 07.02.2017, 17:22 | Сообщение № 7

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

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

Быть или не быть, вот в чем загвоздка!

Ответить

Yar4i

Дата: Вторник, 07.02.2017, 18:01 | Сообщение № 8

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 137

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата RAN, 07.02.2017 в 17:22, в сообщении № 7 ()

Как обратиться к диапазону из 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 "Привет"
Открываю два файла, запускаю в первом и опять на первом активном "приветы" есть, а на неактивный файл (но открытый) код не отрабатывает.

Ответить

Manyasha

Дата: Вторник, 07.02.2017, 18:41 | Сообщение № 9

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 901 ±

Замечаний: 0% ±

Excel 2010, 2016

Цитата Yar4i, 07.02.2017 в 18:01, в сообщении № 8 ()

правильный пример из ссылки

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

Найдите в статье фразу

Цитата

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

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

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

ЯД: 410013299366744 WM: R193491431804

Ответить

K-SerJC

Дата: Среда, 08.02.2017, 08:35 | Сообщение № 10

Группа: Проверенные

Ранг: Обитатель

Сообщений: 487

Репутация: 86 ±

Замечаний: 0% ±

Excel 2013

Цитата Yar4i, 07.02.2017 в 16:45, в сообщении № 4 ()

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

next это окончание цикла, цикл вы задаете тут:
[vba]

Код

For Each Wbn In Workbooks

[/vba]

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

Код

next Wbn

[/vba]

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

Ответить

Yar4i

Дата: Среда, 08.02.2017, 10:44 | Сообщение № 11

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 137

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата Manyasha, 07.02.2017 в 18:41, в сообщении № 9 ()

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

В этом и суть. Стоит мне сохранить книги (допустим на рабочем столе) и назвать их "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"... и далее по коду ссылаться на эти временные имена файлов и после переименовывать в постоянные.
Или поочередно активировать каждый лист - лист он же активируется при проигрывании кода по закрытию файлов без каких-либо запросов.

Цитата Manyasha, 07.02.2017 в 18:41, в сообщении № 9 ()

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

В этом и суть. Стоит мне сохранить книги (допустим на рабочем столе) и назвать их "1.xlsx" и "2.xlsx".
[vba]

Код

К сообщению приложен файл: 6330469.jpg (39.2 Kb)

Ответить

Сообщение

Цитата Manyasha, 07.02.2017 в 18:41, в сообщении № 9 ()

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

В этом и суть. Стоит мне сохранить книги (допустим на рабочем столе) и назвать их "1.xlsx" и "2.xlsx".
[vba]

Код

Автор - Yar4i
Дата добавления - 08.02.2017 в 10:44

Pelena

Дата: Среда, 08.02.2017, 10:48 | Сообщение № 12

Группа: Админы

Ранг: Местный житель

Сообщений: 19401

Репутация: 4549 ±

Замечаний: ±

Excel 365 & Mac Excel

Цитата Yar4i, 07.02.2017 в 18:01, в сообщении № 8 ()

изменю на правильный пример

правильный пример будет
[vba]

Код

.Range("A1,B10").Value = "Привет"

[/vba]
Говорю прямым текстом, потому что по ссылкам Вы не ходите и справку не читаете

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Yar4i

Дата: Среда, 08.02.2017, 11:20 | Сообщение № 13

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 137

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата Pelena, 08.02.2017 в 10:48, в сообщении № 12 ()

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

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

Код

For Each Wbn In Workbooks

[/vba]
Спасибо.

Ответить

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

Ответить

Yar4i

Дата: Среда, 08.02.2017, 14:15 | Сообщение № 15

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 137

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

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

Ответить

RAN

Дата: Среда, 08.02.2017, 14:58 | Сообщение № 16

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

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

Код

Application.Quit

[/vba]

Быть или не быть, вот в чем загвоздка!

Ответить

Yar4i

Дата: Среда, 08.02.2017, 15:23 | Сообщение № 17

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 137

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата RAN, 08.02.2017 в 14:58, в сообщении № 16 ()

при закрытом 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

Ответить

K-SerJC

Дата: Среда, 08.02.2017, 16:41 | Сообщение № 18

Группа: Проверенные

Ранг: Обитатель

Сообщений: 487

Репутация: 86 ±

Замечаний: 0% ±

Excel 2013

Цитата Yar4i, 08.02.2017 в 15:23, в сообщении № 17 ()

Запускаю код

а где в этом коде вы 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

Ответить

Yar4i

Дата: Среда, 08.02.2017, 17:10 | Сообщение № 19

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 137

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата K-SerJC, 08.02.2017 в 16:41, в сообщении № 18 ()

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

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

ой [vba]

Код

Dim strPath$

[/vba] не прописал

Сообщение отредактировал Yar4i - Среда, 08.02.2017, 17:13

Ответить

Yar4i

Дата: Среда, 08.02.2017, 17:30 | Сообщение № 20

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 137

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата K-SerJC, 08.02.2017 в 16:41, в сообщении № 18 ()

[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

Ответить

Применить макрос ко всем открытым книгам (Макросы/Sub)

Страница 1 из 2
1
2
»