Получить имя активного файла Excel и создать копию

@The_Fog · Регистрация: 24.02.2016

Студворк — интернет-сервис помощи студентам

Скрипт должен получить имя активного файла, создать его копию, и в копии имени заменить некоторые символы.
Например файл назывался "12File_Name.xlsm" нужно создать копию с именем "!55File_Name.xlsm". Подскажите как реализовать такую замену символов в имени.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Sub Create_xls()
Sheets(1).Copy
With ActiveWorkbook
With .Sheets(1)
.Rows("11:" & .Rows.Count).Delete
.Columns("E:IV").Delete
End With
.SaveAs Filename:=ThisWorkbook.Path & "\!55" & "ThisWorkbook.Name"
.Close True
End With
End Sub

т.е. проблема со строчкой

Visual Basic
1
.SaveAs Filename:=ThisWorkbook.Path & "\!55" & "ThisWorkbook.Name"

Добавлено через 28 минут
Вот нашел на форуме такое решение

Visual Basic
1
.SaveAs Filename:=ThisWorkbook.Path & "\!" & Replace(ActiveDocument.Name, "23", "55")

Но пишет ошибку Run-time error '424' Object required.

=(

toiai · 30.01.2017, 13:58

Сообщение от The_Fog

Replace(ActiveDocument.Name

А причем здесь ActiveDocument?

@The_Fog · 30.01.2017, 14:15 **[ТС]**

Я так понял

PureBasic
1
ActiveDocument.Name

с помощью этой функции можно получить имя файла. Если нет подскажите пожалуйста как получить это имя и заменить в нем пару символов.

toiai · 30.01.2017, 14:19

Сообщение от The_Fog

ActiveDocument.Name

Это Word документ...
может так

Visual Basic
1
ThisWorkbook.Name

@The_Fog · 30.01.2017, 14:37 **[ТС]**

Visual Basic
1
ThisWorkbook.Name

Не не не, я тоже думал что так, но не так =(

Тоже выдает ошибку =(

@Hugo121 · 30.01.2017, 14:40

ThisWorkbook - это не активная книга, а книга с кодом, не факт что они совпадают!

@The_Fog · 30.01.2017, 15:22 **[ТС]**

обе функции ошибку выдают

Visual Basic
1
.SaveAs Filename:=ThisWorkbook.Path & "\!" & Replace(ActiveDocument.Name, "23", "55")

@CyberHelp · 30.01.2017, 15:27

Visual Basic
1
2
3
4
5
6
Public Sub Fog()
Dim Fog1, Fog2 As String
Fog1 = ActiveWorkbook.Name
Fog2 = ActiveWorkbook.Path
ActiveWorkbook.SaveAs Filename:=Fog2 + "\!55" + Fog1
End Sub

Этот макрос скопирует вам активный файл excel в ту же директорию, где находится активный файл, при этом активный файл (например "файл1") будет закрыт и будет открыто окно сохраненного файла (например "!55файл1").

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

@The_Fog · 30.01.2017, 16:53 **[ТС]**

не получается ошибка...

@CyberHelp · 30.01.2017, 17:30

1) Скиньте скриншот.
2) Вы код куда сохранили код макросов? В личную книгу макросов PERSONAL.XLSB?

У меня всё отлично работает.

@CyberHelp · 30.01.2017, 17:37

Вот вложил файл. Зайдите и нажмите на кнопку.
К кнопке привязан код.

@pashulka · 30.01.2017, 18:13

The_Fog, Если проблема только в имени нового файла, то :

Visual Basic
1
2
3
4
5
6
Private Sub Test()
    Worksheets(1).Copy
    Rows("11:" & Rows.Count).Delete
    Columns("E:" & Columns.Count).Delete
    ActiveWorkbook.Close True, Replace(ThisWorkbook.FullName, "12", "!55")
End Sub

@The_Fog · 31.01.2017, 12:51 **[ТС]**

Visual Basic
1
2
3
4
5
6
Public Sub Fog()
Dim Fog1, Fog2 As String
Fog1 = ActiveWorkbook.Name
Fog2 = ActiveWorkbook.Path
ActiveWorkbook.SaveAs Filename:=Fog2 + "\!55" + Fog1
End Sub

Этот макрос скопирует вам активный файл excel в ту же директорию, где находится активный файл, при этом активный файл (например "файл1") будет закрыт и будет открыто окно сохраненного файла (например "!55файл1").

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

Ваш код работает, а у меня почему то нет

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Create_xls()
Dim Fog1, Fog2 As String
 Fog1 = ActiveWorkbook.Name
Fog2 = Replace(Fog1, "ÆÄÓ", "ÝèÔ")
Sheets(1).Copy
With ActiveWorkbook
With .Sheets(1)
.Rows("11:" & .Rows.Count).Delete
.Columns("E:IV").Delete
End With
'ActiveWorkbook.Close True, Replace(ThisWorkbook.FullName, "ÆÄÓ.xlsm", "ÝèÔ.xlsm")
 
'.SaveAs Filename:=ThisWorkbook.Path & "\!" & Replace(ThisWorkbook.FullName, "ÆÄÓ", "ÝèÔ")
.SaveAs Filename:=ThisWorkbook.Path & "\!" + "Fog2"
.Close True
End With

@Hugo121 · 31.01.2017, 12:52

The_Fog, что напишет

Visual Basic
1
msgbox ThisWorkbook.FullName

@CyberHelp · 31.01.2017, 17:11

Попробуйте заменить & на + везде

@Hugo121 · 31.01.2017, 17:15

CyberHelp, вообще обычно рекомендуют делать наоборот

@CyberHelp · 31.01.2017, 17:24

Мой код тоже не работал пока я & не заменил на + :-D

@Hugo121 · 31.01.2017, 17:26

Это интересно, не слышал о таком казусе. Это на какой системе такое?

@The_Fog · 01.02.2017, 17:12 **[ТС]**

Ошибка в моем коде была...
Вот правильный вариант :

Visual Basic
1
2
3
4
5
6
7
8
Sub Create_xls()
With ActiveWorkbook
With .Sheets(1)
.Rows("150:" & .Rows.Count).Delete
.Columns("Q:IV").Delete
End With
 
.SaveAs Filename:=.Path & "\!" & Replace(.Name, "ЖДУ.xlsm", "ЭиФ.xlsm")

Новые блоги и статьи Все статьи Все блоги /
AkelPad-скрипты, структуры, и немного лирики.. testuser2 05.04.2026 Такая программа, как AkelPad существует уже давно, и также давно существуют скрипты под нее. Тем не менее, прога живет, периодически что-то не спеша дополняется, улучшается. Что меня в первую очередь. . .	Отображение реквизитов в документе по условию и контроль их заполнения Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеСпецтехники", разработанного в конфигурации КА2. Данный документ берёт данные из другого нетипового документа. . .	Фото всей Земли с борта корабля Orion миссии Artemis II kumehtar 04.04.2026 Это первое подобное фото сделанное человеком за 50 лет. Снимок называют новым вариантом легендарной фотографии «The Blue Marble» 1972 года, сделанной с борта корабля «Аполлон-17». Новое фото. . .	Вывод диалогового окна перед закрытием, если документ не проведён Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать программный контроль на предмет проведения документа. . .
Программный контроль заполнения реквизита табличной части документа Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: 1. Реализовать контроль заполнения реквизита. . .	wmic не является внутренней или внешней командой Maks 02.04.2026 Решение: DISM / Online / Add-Capability / CapabilityName:WMIC~~~~ Отсюда: https:/ / winitpro. ru/ index. php/ 2025/ 02/ 14/ komanda-wmic-ne-naydena/	Программная установка даты и запрет ее изменения Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: при создании документов установить период списания автоматически. . .	Вывод данных в справочнике через динамический список Maks 01.04.2026 Реализация из решения ниже выполнена на примере нетипового справочника "Спецтехника" разработанного в конфигурации КА2. Задача: вывести данные из ТЧ нетипового документа. . .

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	30.01.2017, 14:40
	ThisWorkbook - это не активная книга, а книга с кодом, не факт что они совпадают! 0

@The_Fog 0 / 0 / 2 Регистрация: 24.02.2016 Сообщений: 75
	30.01.2017, 16:53 [ТС]
	не получается ошибка... 0

@CyberHelp 6 / 6 / 1 Регистрация: 29.01.2017 Сообщений: 29
	30.01.2017, 17:30
	1) Скиньте скриншот. 2) Вы код куда сохранили код макросов? В личную книгу макросов PERSONAL.XLSB? У меня всё отлично работает. 0

@CyberHelp 6 / 6 / 1 Регистрация: 29.01.2017 Сообщений: 29
	31.01.2017, 17:11
	Попробуйте заменить & на + везде 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	31.01.2017, 17:15
	CyberHelp, вообще обычно рекомендуют делать наоборот 0

@CyberHelp 6 / 6 / 1 Регистрация: 29.01.2017 Сообщений: 29
	31.01.2017, 17:24
	Мой код тоже не работал пока я & не заменил на + :-D 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	31.01.2017, 17:26
	Это интересно, не слышал о таком казусе. Это на какой системе такое? 0