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

Новые блоги и статьи Все статьи Все блоги /
Символьное дифференцирование igorrr37 13.02.2026 / * Программа принимает математическое выражение в виде строки и выдаёт его производную в виде строки и вычисляет значение производной при заданном х Логарифм записывается как: (x-2)log(x^2+2) -. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .	И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»
SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL3_image 8Observer8 10.02.2026 Содержание блога Библиотека SDL3_image содержит инструменты для расширенной работы с изображениями. Пошагово создадим проект для загрузки изображения формата PNG с альфа-каналом (с прозрачным. . .	Установка Qt-версии Lazarus IDE в Debian Trixie Xfce volvo 10.02.2026 В общем, достали меня глюки IDE Лазаруса, собранной с использованием набора виджетов Gtk2 (конкретно: если набирать текст в редакторе и вызвать подсказку через Ctrl+Space, то после закрытия окошка. . .

@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