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

Новые блоги и статьи Все статьи Все блоги /
Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .	SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .	SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий 8Observer8 02.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip Сканируйте QR-код на мобильном и вы увидите, что появится джойстик для управления главным героем. . . .
Реалии Hrethgir 01.03.2026 Нет, я не закончил до сих пор симулятор. Эта задача сложнее. Не получилось уйти в плавсостав, но оно и к лучшему, возможно. Точнее получалось - но сварщиком в палубную команду, а это значит, в моём. . .	Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .	SDL3 для Web (WebAssembly): Сборка библиотек: SDL3, Box2D, FreeType, SDL3_ttf, SDL3_mixer и SDL3_image из исходников с помощью CMake и Emscripten 8Observer8 27.02.2026 Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .	SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .

@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