Excel как применить макрос ко всем файлам - Word и Excel

1 / 1 / 0

Регистрация: 29.07.2020

Сообщений: 42

Excel

02.09.2020, 17:49. Показов 6497. Ответов 10

Есть общиймакрос, в котором содержатся 6 макросов, последовательно выполняющих свои действия к одинаковым по структуре файлам (файл с кодом во вложении).
Можно ли добавить к этому коду следующие действия → выбрать Путь к папке с Exel файлами, к которым требуется применение данного кода, с последующим сохранением файлов после выполнение операций.

P.S. Большее кол-во действий записано через : Конструктор → запись макроса. (как умею, только учусь)
По поиску схожих тем на форуме, решение не нашел. Есть похожее, но только с одним действием (макросом).

Заранее благодарен!

6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

02.09.2020, 18:23

Указать макросу каталог нет особых проблем, можно брать любой код где есть Application.FileDialog(msoFileDialogFolderPicker), но проще будет дать макросу список файлов (Application.FileDialog(msoFileDialogFilePicker)).
Потому что если только каталог — нужен код перебора всех файлов.
Но сперва нужно в этих 6 макросах разобраться с каким листом они вообще работают (в паре есть указания, а остальные тупо работают с чем попало).
Тогда можно выполнить ещё один основной макрос, который в цикле окрывает очередной файл, вызывает Общиймакрос(), тот выполняет с файлом те 6, затем основной макрос закрывает файл с сохранением.

Burk

1811 / 1134 / 345

Регистрация: 11.07.2014

Сообщений: 3,999

02.09.2020, 18:27

Мда … «Не стреляйте в пианиста, он играет как умеет.» А почему макросы поместили в текстовый файл, а отослать экселевский трудно, расширение xlsm не пропускает? Послать в архиве или сохранить как файл с расширением xls без архивации. Но перед этим можете уменьшить код хотя бы убрав практически все Selection, ну так макрорекодер создает макросы, поэтому лучше подредактировать его макросы. Для примера, вместо

Visual Basic

    Columns("W:W").Select
    Selection.ColumnWidth = 10.14
' лучше записать напрямую
    Columns("W:W").ColumnWidth = 10.14

1 / 1 / 0

Регистрация: 29.07.2020

Сообщений: 42

03.09.2020, 10:02

[ТС]

Добрый день,

Файл *xlsm (в архиве) во вложении.

Вложения

MB_.7z (27.5 Кб, 14 просмотров)

1 / 1 / 0

Регистрация: 29.07.2020

Сообщений: 42

03.09.2020, 10:08

[ТС]

Burk, про Пианиста это ты в точку!) Спасибо поднял настроение.
К сожалению я не программист, в письме я это подчеркнул — не судите строго.

Однако данный макрос, пусть и написан на коленках в макрорекодере — но он очень выручает меня.

Все что бы хотелось бы сделать — это массовая обработка … (файл *xlsm выше )

2628 / 1634 / 744

Регистрация: 23.03.2015

Сообщений: 5,135

03.09.2020, 11:28

Vlad1792,
Иногда легче написать заново, чем поправлять /переделывать «чужой» код.
Приведите ваше Т.З. Возможно, ребята вам здесь найдут более рациональный способ решения…

6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

03.09.2020, 11:42

На мой пост реакции наверное не будет… Ну я тогда пошёл по другим делам.

КостяФедореев

Часто онлайн

790 / 529 / 237

Регистрация: 09.01.2017

Сообщений: 1,820

03.09.2020, 11:59

Vlad1792,

Visual Basic

Sub Folder()
    Dim sFolder As String, sFiles As String
    Dim wb As Workbook
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        Set wb = Application.Workbooks.Open(sFolder & sFiles)
        
        Макрос1
        Макрос2
        Макрос3
        Макрос4
        Макрос5
        Макрос6
        
        wb.Close True
        sFiles = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Перебор всех фалов в папке

Vlad1792

1 / 1 / 0

Регистрация: 29.07.2020

Сообщений: 42

03.09.2020, 12:23

[ТС]

Все спасибо !
Удалось реализовать следующим способом:

Visual Basic

Sub OpenDialod()
    Dim ipath$, fname$, book As Workbook
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then ipath = .SelectedItems(1) Else Exit Sub
    End With
    fname = Dir(ipath & "*.xls*")
    Do While fname <> ""
        Set book = Workbooks.Open(ipath & Application.PathSeparator & fname)
        Call Общиймакрос
        book.Close True
        fname = Dir
    Loop
End Sub

Burk

1811 / 1134 / 345

Регистрация: 11.07.2014

Сообщений: 3,999

03.09.2020, 12:41

Vlad1792, да никто и не судит, я даже в восхищении. Иногда пишешь, что бы воспользовались рекодером, но как-то не обращают внимания. А вы такой проект записали макрорекодером! Только надо бы его потом оптимизировать, как я писал. На всякий случай для примера подрисовал Макрос1.
А теперь про массовую обработку — Hugo121 ведь вам писал,. Или можно просто завести папку с файлами (.xlsx) для обработки, имена у них сделать по какому-то шаблону и перебирать их запуском ОбщегоМакроса. Перебор файлов тоже вставить в этот макрос. Про Application.FileDialog Hugo121 знает лучше меня, я делал по-простому через функцию Dir. Кстати, а ширина колонок, например 7.26 и 7.75 это принципиально, может можно уменьшить подобное разнообразие и ещё сократить макрос.

Кликните здесь для просмотра всего текста

Visual Basic

Sub Макрос1()
Dim I As Integer
    Columns("Y:Y").Delete Shift:=xlToLeft
    'а то, что АС после удаления сдвинется это ничего?
    For I = 1 To 5: Columns("AC:AC").Insert Shift:=xlToRight: Next
    Range("table1[[#Headers],[Unit of Measurement 12]]").Select
    Columns("V:AG").NumberFormat = "0.000"
    Columns("A:A").ColumnWidth = 12.29
    Columns("B:B").ColumnWidth = 10.14
    Columns("C:C").ColumnWidth = 11.29
    Range("D:F,K:L").ColumnWidth = 6.43
    Columns("G:G").ColumnWidth = 8.29
    Range("H:J").ColumnWidth = 10.71
    Columns("M:M").ColumnWidth = 7.29
    Columns("N:N").ColumnWidth = 18.43
    Columns("O:O").ColumnWidth = 9.71
    Columns("P:P").ColumnWidth = 7.86
    Columns("Q:Q").ColumnWidth = 4.86
    Columns("R:R").ColumnWidth = 18.86
    Columns("S:S").ColumnWidth = 22.43
    Columns("T:T").ColumnWidth = 5.86
    Columns("U:U").ColumnWidth = 14.29
    Range("V:W,Y:AA").ColumnWidth = 10.14
    Columns("X:X").ColumnWidth = 5.29
    Columns("AB:AB").ColumnWidth = 5.14
    Columns("AC:AG").ColumnWidth = 15.4
    Columns("AH:AL").ColumnWidth = 10.86
    Range("AC4").Formula = "=Z3-15"
Range("AD4").Formula = "=Z3-AC4"
Range("AE4").Formula = "=W4+AC4"
Range("AF4").Formula = "=1"
Range("AG4").Formula = "=1"
Range("AC2:AG3").ClearContents
Selection.AutoFilter
    ActiveSheet.ListObjects("table1").Range.AutoFilter Field:=29, Criteria1:= _
        "-15,000"
    Columns("AC:AD").ClearContents
    Columns("AF:AG").ClearContents
    ActiveSheet.ListObjects("table1").Range.AutoFilter Field:=29
    Columns("AE:AE").ClearContents
    ActiveSheet.ListObjects("table1").Range.AutoFilter Field:=31, Criteria1:= _
        "0,000"
    ActiveSheet.ListObjects("table1").Range.AutoFilter Field:=31
    Range("AC1") = "Вес упаковки"
Range("AD1") = "Вес паллет"
Range("AE1") = "Вес брутто без паллет"
Range("AF1") = "кол-во упаковок"
Range("AG1") = "кол-во паллет"
    Columns("AC:AG").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AC1").Select
End Sub

1 / 1 / 0

Регистрация: 29.07.2020

Сообщений: 42

03.09.2020, 14:56

[ТС]

Burk, благодарю! лишние Selection в коде убрал.
Это заметно ускорило работу макроса.

С массовой обработкой разобрались, писал выше)

IT_Exp

Эксперт

87844 / 49110 / 22898

Регистрация: 17.06.2006

Сообщений: 92,604

03.09.2020, 14:56

Помогаю со студенческими работами здесь

Цикл по всем файлам в папке
Добрый день!
Подскажите, пожалуйста, какой-нибудь несложный способ перебрать в цикле все книги в…

Смена расширения всем файлам в папке на одно
Есть папка с файлами, iso, bin, gen, smd…
Нужно всем им поставить расширение — gen.
Так то есть…

Задать случайную дату создания всем файлам в папке
Старый муз. центр не умеет воспроизводить в случайном порядке. Воспроизведение идет по дате…

Как с использованием VBA обратиться ко всем .xls файлам в определённой папке?
Просьба понимающих помочь в следующей ситуации: к примеру в каталоге "Мои документы" есть две…

Перенаправление в .htaccess. Как все запросы к файлам в одной папке перенаправить к файлам в другой папке
Здравствуйте,

нужно сделать второй сайт, который будет почти копией существующего.
оба сайта на…

Как объявить переменную, в которую будут записаны пути ко всем найденным файлам
Здравствуйте, в данном контексте
‘папка, в которой происходит поиск файлов с расширением .doc
…

Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:

Источник

jfd

Пользователь

Сообщений: 302
Регистрация: 01.01.1970

Добрый день!
В поиске есть похожие решения? но немного не то. Поэтому решил спросить отдельно.
Нужно применить макрос ко всем книгам в папке, кроме одной, имя которой можно получить макросом.
Есть следующее: Папка в экселевскими файлами. Макрос создает файл в этой папке, в который записываются результаты обработки файлов содержащихся в папке (через диалог). Путь к папке известен, имя файла-исключения известно. Нужно применить макрос ко всем файлам, кроме созданного и известного файла. Осложняется тем? что могу быть открыты и другие книги, из других папок.
Нужен какой-то метод который сможет перебрать все файлы по условию.
Помогите, плиз.

Изменено: jfd — 01.04.2013 01:07:26

ber$erk Пользователь Сообщений: 2735 Регистрация: 25.12.2012	если Вы макрос проходит в цикле по файлам из конкретной папки, то «другие книги из других папок» никоим образом не помешают ему. Изменено: ber$erk — 27.03.2013 13:12:16 Учимся сами и помогаем другим…

Юрий

Пользователь

Сообщений: 212
Регистрация: 27.12.2012

27.03.2013 13:41:53

Добрый день.

Предлагаю создать отдельный лист, в который выгрузить список всех файлов из необходимой папки. В соседнюю ячейку внести формулу «если» для получения списка без «ненужный» файлов. Запустить макрос с последовательной обработкой файлов по именам из «обработанных ячеек».

Извлечение списка приложил.
Второй макрос, сами писали, что

Цитата
jfd пишет: В поиске есть похожие решения

Прикрепленные файлы

список файлов в папке.xls (39.5 КБ)

Юрий М Модератор Сообщений: 60570 Регистрация: 14.09.2012 Контакты см. в профиле	Нет необходимости создавать лист и формулы — ber$erk прав: будут обработаны только файлы из выбранной папки. Добавить в цикле проверку на имена: файла с макросом и создаваемого файла.

jfd Пользователь Сообщений: 302 Регистрация: 01.01.1970	Юрий М, я понимаю что это надо сделать , но не знаю чем

Юрий М

Модератор

Сообщений: 60570
Регистрация: 14.09.2012

Контакты см. в профиле

27.03.2013 13:52:09

Я полагал, что вариант перебора файлов Вы УЖЕ нашли.

Цитата
В поиске есть похожие решения

В поиск: перебрать файлы в папке.

jfd

Пользователь

Сообщений: 302
Регистрация: 01.01.1970

27.03.2013 17:45:05

не пинайте сильно, не могу разобраться почему в одном случае работает? а в другом нет
работает:

Код

Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
   ' With Application.FileDialog(msoFileDialogFolderPicker)
   '     If .Show = False Then Exit Sub
   '     sFolder = .SelectedItems(1)
   ' End With
    sFolder = "D:Excell1"
    'sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls")
    Do While sFiles <> ""
        'открываем книгу
        Workbooks.Open sFolder & sFiles

sFiles равно файлу с нужным расширением

не работает:

Код

Sub Реестр()
Dim visitTime, dateVisit As Date
Dim kontrName, kontrAdr, sotrIndex, FolderPath, sFiles As String


Set regWb = Excel.Workbooks.Add()
ActiveWorkbook.Application.Dialogs(xlDialogSaveAs).Show
FolderPath = CStr(ActiveWorkbook.Path)
Filename = ActiveWorkbook.Name
MsgBox FolderPath
ActiveWindow.ActivatePrevious
           
    'FolderPath = FolderPath & IIf(Right(FolderPath, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = True
    sFiles = Dir(FolderPath & "*.xls")
    Do While sFiles <> ""

sFiles равно имени книги которая была создана этим макросом (переменная FileName)

Изменено: jfd — 27.03.2013 17:45:43

jfd Пользователь Сообщений: 302 Регистрация: 01.01.1970	EducatedFool, спасибо. разумеется это видел. нужна не рыба, нужна удочка

EducatedFool

Пользователь

Сообщений: 3631
Регистрация: 23.12.2012

#10

27.03.2013 18:09:54

Цитата
нужна не рыба, нужна удочка

странные вы люди)

по второй ссылке, в прикреплённом файле, — готовое решение, где надо изменить всего одну строку кода
(заменить вставку данных на лист Excel на вызов вашего макроса)

а удочек у меня нет)

The_Prist

Пользователь

Сообщений: 14181
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#11

27.03.2013 18:25:31

Оба кода выложены неполностью и что именно не работает не указано.
Путь переменной FolderPath задан неверно — отсутствует слеш. Значит открытие книги завершится с ошибкой, говорящей об отсутствии файла(кстати, Вам это виднее должно быть — ошибка у Вас появляется).

Код
FolderPath = ActiveWorkbook.Path & ""

следовательно

Код
sFiles = Dir(FolderPath & "*.xls")

Если хотите сверять текущий файл с активной книгой, то надо добавить условие:

Код
Do While sFiles <> "" If Filename <> sFiles then workbooks.Open FolderPath & sFiles

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

jfd

Пользователь

Сообщений: 302
Регистрация: 01.01.1970

The_Prist, постараюсь не превратить обсуждение в то, что написано в вашей подписи.
первый случай работоспособен, я не стал весь код приводить чтобы не занимать место, да и остаток не важен. По F8 мы доходим до главного — присвоения переменой sFiles имени файла из папки с заданной маской. Оно присваивается правильно.
Во втором случае проблема в том что sFiles = Dir(FolderPath & «*.xls») не воспринимает фильтр по маске.
А если написать так sFiles = Dir(FolderPath), то все ОК. начинается перебор всех файлов в папке. Но мне надо перебор не всех, а по маске.

The_Prist

Пользователь

Сообщений: 14181
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

Я же написал — СЛЕШ на законное место верните. Сравните два кода и посмотрите какое у Вас в результате имя у файла для открытия получается, если слеш не указать.

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

jfd

Пользователь

Сообщений: 302
Регистрация: 01.01.1970

#14

27.03.2013 22:21:25

The_Prist, я по всякому пробовал. в итоге пришлось извратиться вот так

Код

Sub Реестр()
Dim visitTime, dateVisit As Date
Dim kontrName, kontrAdr, sotrIndex, FolderPath, sFiles As String

FolderPath = ThisWorkbook.Path & ""
regWb = ThisWorkbook.Name

    Application.ScreenUpdating = False
    sFiles = Dir(FolderPath)
    Do While sFiles <> "" And sFiles <> "реестр фото.xlsm"

макрос записать в файл реестр фото и положить его в папку с файлами к которым нужно применить макрос. т.е. «реестр фото.xlsm» и есть тот файл исключение, который не надо обрабатывать. в него же и собираются данные с остальных файлов в этой папке.

Изменено: jfd — 27.03.2013 22:25:29

The_Prist

Пользователь

Сообщений: 14181
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#15

27.03.2013 22:32:30

Да? Ну вот почему я пробую — у меня работает, если слеш поставить.
Давайте теперь будем посимвольно:

Код
FolderPath = CStr(ActiveWorkbook.Path)

допустим книга в папке «Папка1» на диске С. Какую строку вернет ActiveWorkbook.Path? Верно: «C:Папка1». Слеша НЕТ.

Код
FolderPath & "*.xls"

здесь Вы его добавляете вручную. Т.е. получается «C:Папка1*.xls» и мы просматриваем в Папка1 файлы .xls. Все верно. Первым пусть будет Файл1.xls.

Код
Workbooks.Open FolderPath & sFiles

Но что тогда будет здесь? Верно: Workbooks.Open «C:Папка1Файл1.xls».
Т.е. код будет пытаться открыть в корне диска С файл, который по сути расположен в Папка1, и название которого — «Папка1Файл1.xls«.

Теперь понятнее зачем нужен более полный код? И в чем может быть ошибка там, где Вы нам её не хотите показывать?

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

jfd Пользователь Сообщений: 302 Регистрация: 01.01.1970	The_Prist, я приложу архив с папкой путь к которой я использовал и полный код макроса. посмотрите что присваивается sFile в 13 строке. у меня «бяка.xlsm» Прикрепленные файлы c1.ZIP (32.46 КБ) Изменено: jfd — 27.03.2013 22:53:46

Sergei_A

Пользователь

Сообщений: 443
Регистрация: 05.01.2013

#17

27.03.2013 23:01:41

Меняем

Код
sFiles = Dir(FolderPath & "*.xls")

на

Код
sFiles = Dir(FolderPath & ".xls")

jfd Пользователь Сообщений: 302 Регистрация: 01.01.1970	Sergei_A, мне нужны только файлы с расширением .xls иначе для меня это все равно что не указывавать маску

The_Prist

Пользователь

Сообщений: 14181
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#19

27.03.2013 23:04:51

Вот что…У Вас проблема в том, что не только xls, но и остальные Excel файлы попадают. Сделайте проверку:

Код
If right(sFiles,4) = ".xls" then 'обрабатываем end if

Так проще и надежнее всего будет.

Если не угадал опять — опишите уже нормально, что именно в коде не устраивает.

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

jfd

Пользователь

Сообщений: 302
Регистрация: 01.01.1970

The_Prist, в принципе да, можно и так (If right(sFiles,4) = «.xls» then) по маске выбрать нудные файлы.
поставленная задача решилась, спасибо за помощь. просто хотелось бы понять, почему у меня не работала маска в
sFiles = Dir(FolderPath & «*.xls») или как могло бы sFiles = Dir(FolderPath & «???_???_*.xls»)

RAN Пользователь Сообщений: 7091 Регистрация: 21.12.2012	#21 30.03.2013 14:59:47 http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=8&TID=28653&MID=250752#message250752

Источник

In Excel, you can make it so all of your macros can be easily accessed by any Excel workbook.

To do this we need to create what is called a «personal macro workbook» and then save it. All of the macros that we want to use in Excel will be stored within this personal macro workbook and will then be accessible by any Excel file.

Steps to Make any Macro Available in All Excel Files

Open an Excel file and then go to record a dummy macro, recording this dummy macro is what will create the «personal macro workbook» that we need in order to store the macros.
To record a macro go to the Developer tab, if that is visible, or simply look to the bottom left of the Excel window. From there, click the Record Macro button:
On the screen that appears, make sure to select Personal Macro Workbook from the Store macro in: drop down box and then hit the OK button. Nothing else matters here because we just need to record a simple macro, anything really.
Select any cell in the worksheet and then just click the Stop Recording macro button, which is in the exact same location as the Record Macro button in step 2.
Now hit Alt + F11 on the keyboard so we can go to the VBA/Macro editor window. You will now see the PERSONAL.XLSB file appear in the top left pane of the window.
All you have to do now is to add Modules and Macros to this file like you would to any normal Excel file. Double-click Module 1 and we see the macro that we just recorded:

As you can see, this new PERSONAL.XLSB file behaves just like a regular file in the VBA window. This is where you will store any macros that you want to be able to access from all Excel files.

Notes

The personal macro workbook file does NOT travel with your Excel files when you send them; this PERSONAL.XLSB file only remains on your computer for you to use. So, if you send a workbook to another person, they will not be able to access the same macros that you have unless you also put those macros in the workbook you sent.

You must follow the above steps to create the personal macro workbook but, once you have created it, you can access it from any workbook on your computer by simply going to the VBA/Macro editor window (Alt + F11). As such, once it is created, adding macros to this new file is the same as adding it to any other Excel file — open any workbook, go to the VBA window, add a module to the PERSONAL.XLSB file and then add a macro.

The sample file for this tutorial is empty because, remember, you cannot send the personal macro workbook file with Excel files.

Excel VBA Course — From Beginner to Expert

200+ Video Lessons
50+ Hours of Instruction
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Subscribe for Weekly Tutorials

BONUS: subscribe now to download our Top Tutorials Ebook!

Excel VBA Course — From Beginner to Expert

200+ Video Lessons

50+ Hours of Video

200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Источник

Содержание

1 Как сохранить макрос в личную книгу макросов
- 1.1 Как создать Личную Книгу Макросов
- 1.2 Как использовать Личную Книгу Макросов
- 1.3 Где хранится Личная Книга Макросов
- 1.4 P.S.
- 1.5 Ссылки по теме

Большинство пользователей Excel знают, как создать и использовать макрос внутри файла одной рабочей книги. В случаи, когда необходимо использовать тот же макрос в других файлах рабочих книг, тогда можно сохранить его в личной книге макросов. У нее всегда одно название – Personal.xlsb. Она всегда открывается при запуске программы Excel, только скрыто. Данная книга не является доступной по умолчанию в Excel, поэтому ее нужно сначала подключить.

Как сохранить макрос в личную книгу макросов

Чтобы создать и схоронить код в личной книге макросов:

Выберите инструмент: «РАЗРАБОТЧИК»-«Код»-«Запись макроса».
В появившемся диалоговом окне «Запись макроса», из выпадающего списка «Сохранить в:» выберите опцию «Личная книга макросов». И нажмите на кнопку OK.
Теперь выберите инструмент: «РАЗРАБОТЧИК»-«Код»-«Остановить запись».
Откройте редактор Visual Basic: «РАЗРАБОТЧИК»-«Код»-«Visual Basic». Или нажмите комбинацию горячих клавиш ALT+F11. В окне «Project-VBAProject», в дереве проектов появиться доступная еще одна книга Personal.xlsb. Кликните на «плюсик» слева на против этой книги, чтобы раскрыть проект книги Personal.xlsb. А после двойным щелчком отройте ее Module1.
В результате откроется окно кода модуля с зарегистрированным макросом. Удалите его код и введите код своего макроса. Выберите инструмент в редакторе макросов: «File»-«Save Personal.xlsb», а потом закройте редактор Visual Basic.

Теперь у вас подключена скрытая книга для хранения макросов, к которым можно получить доступ из любой другой рабочей книги. Личная книга макросов где находится находиться в папке автозагрузки файлов Excel – XLSTART: C:Documents and SettingsUser_NameAppDataRoamingMicrosoftExcelXLSTARTPersonal.xlsb

Примечание. XLSTART – это папка для автозагрузки файлов вместе с запуском программы Excel. Если сохранить файл в данную папку, то он будет открываться вместе с программой Excel. Для версий старше 2007 путь к папке автозагрузки будет следующим: C:Program FilesMicrosoft OfficeOffice12Xlstart.

Если вам нужно записать в нее новый макрос просто откройте редактор, а потом откройте модуль книги Personal.xlsb. Уже записанные в нее макросы удалять не нужно. Они не будут между собой конфликтовать если соблюдать одно простое правило – в одном модуле нельзя хранить макросы с одинаковыми именами.

Если вы еще не знакомы с макросами в Excel, то я вам даже немного завидую. Ощущение всемогущества и осознание того, что ваш Microsoft Excel можно прокачивать почти до бесконечности, которые придут к вам после знакомства с макросами — приятные чувства.

Однако, эта статья для тех, кто уже «познал мощь» и начал использовать макросы (чужие или написанные самостоятельно — не важно) в своей повседневной работе.

Макрос — это код (несколько строк) на языке Visual Basic, которые заставляют Excel сделать то, что вам нужно: обработать данные, сформировать отчет, скопипастить много однообразных таблиц и т.п. Вопрос — где эти несколько строк кода хранить? Ведь от того, где макрос хранится будет потом зависеть где он сможет (или не сможет) работать.

Если макрос решает небольшую локальную проблему в отдельно взятом файле (например обрабатывает внесенные в конкретный отчет данные особым образом), то логично хранить код внутри этого же файла. Без вопросов.

А если макрос должен быть относительно универсален и нужен в любой книге Excel — как, например, макрос для конвертирования формул в значения? Не копировать же его код на Visual Basic каждый раз в каждую книгу? Кроме того, рано или поздно, почти любой пользователь приходит к мысли, что неплохо было бы сложить все макросы в одну коробку, т.е. иметь их всегда под рукой. И может быть даже запускать не вручную, а сочетаниями клавиш? И вот тут может здорово помочь Личная Книга Макросов (Personal Macro Workbook).

Как создать Личную Книгу Макросов

На самом деле, Личная Книга Макросов (ЛКМ) — это обычный файл Excel в формате двоичной книги (Personal.xlsb), который автоматически в скрытом режиме открывается одновременно с Microsoft Excel. Т.е. когда вы просто запускаете Excel или открываете любой файл с диска, на самом деле открываются два файла — ваш и Personal.xlsb, но второго мы не видим. Таким образом все макросы, которые хранятся в ЛКМ оказываются доступы для запуска в любой момент, пока открыт Excel.

Если вы еще ни разу не пользовались ЛКМ, то изначально файл Personal.xlsb не существует. Самый легкий способ его создать — это записать рекордером какой-нибудь ненужный бессмысленный макрос, но указать в качестве места для его хранения Личную Книгу — тогда Excel будет вынужден автоматически ее для вас создать. Для этого:

Откройте вкладку Разработчик (Developer). Если вкладки Разработчик не видно, то ее можно включить в настройках через Файл — Параметры — Настройка ленты (Home — Options — Customize the Ribbon).
На вкладке Разработчик нажмите кнопку Запись макроса (Record Macro). В открывшемся окне выберите Личную книгу макросов (Personal Macro Workbook) как место для хранения записанного кода и нажмите OK:
Остановите запись кнопкой Остановить запись (Stop Recording) на вкладке Разработчик (Developer)

Проверить результат можно, нажав на кнопку Visual Basic там же на вкладке Разработчик — в открывшемся окне редактора в левом верхнем углу на панели Project — VBA Project должен появиться наш файл PERSONAL.XLSB. Его ветку которого можно развернуть плюсиком слева, добравшись до Module1, где и хранится код только что записанного нами бессмысленного макроса:

Поздравляю, вы только что создали себе Личную Книгу Макросов! Только не забудьте нажать на кнопку сохранения с дискеткой в левом верхнем углу на панели инструментов.

Как использовать Личную Книгу Макросов

Дальше все просто. Любой нужный вам макрос (т.е. кусок кода, начинающийся на Sub и заканчивающийся End Sub) можно смело копировать и вставлять либо в Module1, либо в отдельный модуль, добавив его предварительно через меню Insert — Module. Хранить все макросы в одном модуле или раскладывать по разным — исключительно вопрос вкуса. Выглядеть это должно примерно так:

Запустить добавленный макрос можно в диалоговом окне, вызываемом с помощью кнопки Макросы (Macros) на вкладке Разработчик:

В этом же окне, нажав кнопку Параметры (Options), можно задать сочетание клавиш для быстрого запуска макроса с клавиатуры. Будьте внимательны: сочетания клавиш для макросов различают раскладку (русская или английская) и регистр.

Кроме обычных макросов-процедур в Личной Книге можно хранить и пользовательские макро-функции (UDF = User Defined Function). В отличие от процедур, код функций начинаются с оператора Function или Public Function, а заканчиваются на End Function:

Код необходимо аналогичным образом скопировать в любой модуль книги PERSONAL.XLSB и затем можно будет вызвать функцию обычным образом, как любую стандарную функцию Excel, нажав кнопку fx в строке формул и выбрав функцию в окне Мастера Функций в категории Определенные пользователем (User Defined):

Примеры таких функций можно в больших количествах найти в интернете или здесь же на сайте (сумма прописью, приблизительный текстовый поиск, ВПР 2.0, конвертация кириллицы в транслит и т.п.)

Где хранится Личная Книга Макросов

Если вы будете использовать Личную Книгу Макросов, то рано или поздно у вас возникнет желание:

поделиться своими накопленными макросами с другими пользователями
скопировать и перенести Личную Книгу на другой компьютер
сделать ее резервную копию

Для этого нужно будет найти файл PERSONAL.XLSB на диске вашего компьютера. По умолчанию, этот файл хранится в специальной папке автозапуска Excel, которая называется XLSTART. Так что все, что нужно — это добраться до этой папки на нашем ПК. И вот тут возникает небольшая сложность, потому что местоположение этой папки зависит от версии Windows и Office и может различаться. Обычно это один из следующих вариантов:

C:Program FilesMicrosoft OfficeOffice12XLSTART
C:Documents and SettingsComputerApplication DataMicrosoftExcelXLSTART
C:Usersимя-вашей-учетной-записиAppDataRoamingMicrosoftExcelXLSTART

Как вариант, можно спросить о положении этой папки сам Excel с помощью VBA. Для этого в редакторе Visual Basic (кнопка Visual Basic на вкладке Разработчик) нужно открыть окно Immediate сочетанием клавиш Ctrl+G, ввести туда команду ? Application.StartupPath и нажать на Enter:

Полученный путь можно скопировать и вставить в верхнюю строку окна Проводника в Windows и нажать Enter — и мы увидим папку с нашим файлом Личной Книги Макросов:

P.S.

И несколько практических нюансов вдогон:

при использовании Личной Книги Макросов Excel будет запускаться чуть медленнее, особенно на слабых ПК
стоит периодически очищать Личную Книгу от информационного мусора, старых и ненужных макросов и т.п.
у корпоративных пользователей бывают иногда сложности с использованием Личной Книги, т.к. это файл в системной скрытой папке

Ссылки по теме

Что такое макросы, как их использовать в работе
Полезности для VBA-программиста
Тренинг «Программирование макросов на VBA в Microsoft Excel»

Источник

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

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]
Данный макрос вносит некоторые изменения в документ и сохраняет его с последующим закрытием.
Нигде не встречал макрос применительно к открытым книгам (однолистным).
Фото пяти открытых документов — для наглядности.

Ответить

_Boroda_

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

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

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

Сообщений: 16618

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

Замечаний:
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

Ответить

Yar4i

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

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

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

Сообщений: 137

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

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

Excel 2010

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

Ответить

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]

Ответить

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

Дата: Вторник, 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

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

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

Сообщений: 5645

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

Ответить

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

Ответить

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

Ответить

K-SerJC

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

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

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

Сообщений: 487

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

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

Excel 2013

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

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

Код

For Each Wbn In Workbooks

[/vba]

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

[/vba]

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

Ответить

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)

Ответить

Pelena

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

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

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

Сообщений: 18797

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

Замечаний:
±

Excel 2016 & Mac Excel

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

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

Код

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

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

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

Ответить

Yar4i

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

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

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

Сообщений: 137

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

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

Excel 2010

Вот и я думаю, от селектов избавились, а потом к именам вернулись — не может этого быть и ещё сбивало множественное число «РабочихКниг» в шапке кода [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

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

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

Сообщений: 5645

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

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

Ответить

Yar4i

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

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

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

Сообщений: 137

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

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

Excel 2010

да, спасибо. И я нашел у себя лишнее сохранение [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:24

Ответить

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]

[/vba]

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

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

Сообщение отредактировал K-SerJC — Среда, 08.02.2017, 16:49

Ответить

Yar4i

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

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

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

Сообщений: 137

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

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

Excel 2010

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

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

ой [vba]

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

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

Ответить

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

Ответить

Источник