Получить имя активного файла 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")

Новые блоги и статьи Все статьи Все блоги /
Java и Eclipse Store: Сверхбыстрые приложения с In-Memory DB Javaican 15.07.2025 Eclipse Store — это микро-движок персистентности для Java, который позволяет хранить и извлекать нативные Java-объекты без необходимости преобразования данных или использования объектно-реляционного. . .	EmBitz, создание проекта, отладка, прошивка locm 15.07.2025 Создание проекта для Blue Pill (STM32F103C8T6) в EmBitz 2. 30, написания кода blink, запуск отладки в ОЗУ, заливка релизной прошивки во flash используя ST-Link и др. . . .	Трассировка корутин Kotlin с OpenTelemetry mobDevWorks 14.07.2025 Асинхронное программирование меняет правила игры, особенно когда речь заходит о трассировке операций. В Kotlin с его корутинами эта проблема приобретает особый оттенок, который я хотел бы детально. . .	Облачные приложения на Rust: руководство по архитектуре микросервисов golander 13.07.2025 Когда я впервые взялся за проектирование облачной платформы для одного из наших клиентов, выбор стоял между привычными Go и Java. Но после нескольких месяцев разработки микросервисной системы,. . .	Как Node.js выполняет асинхронные операции Reangularity 13.07.2025 Каждый раз, когда я рассказываю про Node. js, возникает один и тот же вопрос: "Как эта штука может быть быстрой, если JavaScript — однопоточный язык?" И это действительно кажется парадоксом. Ведь в. . .
Как писать чистый, тестируемый и качественный код на Python py-thonny 12.07.2025 Помню свой первый проект на Python. Работал тогда быстро, грязно, лишь бы работало. Код был похож на запутанный клубок - переменные по одной букве, функции на 200 строк, комментарии отсутствовали как. . .	Blazor и контроллер сервопривода IoT Meadow Maple Wired 11.07.2025 Я решил разобраться, как можно соединить современные веб-технологии с миром "железа". Интересная комбинация получилась из Blazor в качестве веб-интерфейса и микроконтроллера Meadow с его веб-сервером. . .	Генерация OpenQASM из кода Q# EggHead 10.07.2025 Летом 2024-го я начал эксперименты с библиотекой Q# Bridge, и знаете что? Она оказалась просто находкой для тех, кто работает на стыке разных квантовых экосистем. Основная фишка этой библиотеки -. . .	Изучаем новый шаблон ИИ-чата .NET AI Chat Web App stackOverflow 10.07.2025 В . NET появилось интересное обновление - новый шаблон ИИ-чата под названием . NET AI Chat Web App. Когда я впервые наткнулся на анонс этого шаблона, то сразу понял, что Microsoft наконец-то. . .	Результаты исследования от команды ARP (июль 2025 г.) Programma_Boinc 10.07.2025 Результаты исследования от команды ARP (июль 2025 г. ) Африканский проект по дождям (ARP) World Community Grid снова запущен! Мы рады поделиться обновленной информацией о нашем прогрессе с осени. . .

@Hugo121 6997 / 2895 / 555 Регистрация: 19.10.2012 Сообщений: 8,803
	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 6997 / 2895 / 555 Регистрация: 19.10.2012 Сообщений: 8,803
	31.01.2017, 17:15
	CyberHelp, вообще обычно рекомендуют делать наоборот 0

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

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