Сохранение текущего листа с сохранением имени листа и присвоением новой книге имени текущего листа

@CFShuhrat · Регистрация: 05.08.2019

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

Visual Basic

Sub Save_as()
    With Application.FileDialog(msoFileDialogSaveAs)
        .InitialFileName = ThisWorkbook.Path & "\" & "new book name"
        If .Show = 0 Then Exit Sub
        ThisWorkbook.ActiveSheet.Copy
        Application.DisplayAlerts = False
        .Execute
        Application.DisplayAlerts = True
    End With
    ActiveWorkbook.Close False
End Sub

Этот код предлагает сохранить текущий лист Excel как новую книгу в папке XLSTART, можно ли изменить его так, чтобы он
- предлагал сохранить новую книгу в той же папке, где находится активная книга (лист которой сохраняется как новая книга)
- предлагал в качестве имени новой книги имя текущего листа
- имя листа в новой книге осталось таким же, как и имя текущего листа?

@pashulka · 08.09.2019, 15:07

Без предложений выбора и без проверок

Visual Basic

Private Sub Test()
    ThisWorkbook.ActiveSheet.Copy
    ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & ActiveSheet.Name & ".xls"
End Sub

@CFShuhrat · 08.09.2019, 18:54 **[ТС]**

pashulka,

Да, спасибо, работает, правда, присваивает новой книге имя "Лист1", но для меня были важны также и предложения

@pashulka · 08.09.2019, 18:59

CFShuhrat, Прочитайте название своей темы, там явно сказано, что имя книги = имя листа. Если же нужен ввод имени, то InputBox, а если выбор папки + имя, то один из вариантов Application.GetSaveAsFilename

@CFShuhrat · 09.09.2019, 07:17 **[ТС]**

pashulka,

Быть может я был не точен в постановке вопроса, но сейчас я бы просил изменить исходный код

Visual Basic

Sub Save_as()
    With Application.FileDialog(msoFileDialogSaveAs)
        .InitialFileName = ThisWorkbook.Path & "\" & "new book name"
        If .Show = 0 Then Exit Sub
        ThisWorkbook.ActiveSheet.Copy
        Application.DisplayAlerts = False
        .Execute
        Application.DisplayAlerts = True
    End With
    ActiveWorkbook.Close False
End Sub

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

@pashulka · 09.09.2019, 09:22

Visual Basic

Private Sub Test2()
    Dim p$, f As Variant
    p = ThisWorkbook.Path & "\"
    ChDrive Left(p, 1): ChDir p
    f = Application.GetSaveAsFilename( _
    ThisWorkbook.ActiveSheet.Name, "Excel Files (*.xls), *.xls")
    If f <> False Then
       ThisWorkbook.ActiveSheet.Copy
       ActiveWorkbook.Close True, f
    End If
End Sub

Visual Basic

Private Sub Test3()
    Dim f As Variant
    f = ThisWorkbook.Path & "\" & ThisWorkbook.ActiveSheet.Name
    f = Application.GetSaveAsFilename(f, "Excel Files (*.xls), *.xls")
    If f <> False Then
       ThisWorkbook.ActiveSheet.Copy
       ActiveWorkbook.Close True, f
    End If
End Sub

@CFShuhrat · 09.09.2019, 10:06 **[ТС]**

pashulka, Да, спасибо Вам большое, оба кода работают

@CFShuhrat · 11.09.2019, 06:29 **[ТС]**

pashulka, Оба кода не копируют лист, а создают пустой лист

@pashulka · 11.09.2019, 07:34

CFShuhrat,

Visual Basic

1	ThisWorkbook.ActiveSheet.Copy

очевидно, что везде копируется активный лист текущей книги, и если он пустой (например, если код находится в личной книге макросов Personal.xls(b)), то и результат будет аналогичен.

P.S. Обратите внимание, на то, что в первом примере также использовался именно этот лист, и изначально притензий к пустоте не было. Также можете посмотреть разницу между ThisWorkbook и ActiveWorkbook, возможно Вам нужна не текущая книга, а активная.

@CFShuhrat · 11.09.2019, 08:12 **[ТС]**

pashulka,

Вот мой порядок действий:

1. копирую код Test2() с темы
2. создаю модуль в папке Modules в VBAProject (PERSONAL.XLSB) - в новом модуле сверху уже есть строчка Option Explicit - удаляю ее.
3. открыта одна книга, лист не пустой
4. Alt+F8: нет макроса Test2() ни в каких списках
5. удаляю слово Private в коде - макрос появился в списке Personal
6. запускаю макрос - создается новая книга с одним пустым листом

@pashulka · 11.09.2019, 09:08

CFShuhrat, Ещё раз, посмотрите разницу между thisworkbook и activeworkbook

@CFShuhrat · 11.09.2019, 10:09 **[ТС]**

pashulka,

Замена ThisWorkbook.ActiveSheet.Copy на ActiveWorkbook.ActiveSheet.Copy в обоих кодах действительно помогла, огромное Вам спасибо!

@CFShuhrat 0 / 0 / 0 Регистрация: 05.08.2019 Сообщений: 69
	08.09.2019, 18:54 [ТС]	3
	pashulka, Да, спасибо, работает, правда, присваивает новой книге имя "Лист1", но для меня были важны также и предложения 0

@pashulka 4135 / 2239 / 940 Регистрация: 01.12.2010 Сообщений: 4,624
	08.09.2019, 18:59	4
	CFShuhrat, Прочитайте название своей темы, там явно сказано, что имя книги = имя листа. Если же нужен ввод имени, то InputBox, а если выбор папки + имя, то один из вариантов Application.GetSaveAsFilename 1

@CFShuhrat 0 / 0 / 0 Регистрация: 05.08.2019 Сообщений: 69
	09.09.2019, 10:06 [ТС]	7
	pashulka, Да, спасибо Вам большое, оба кода работают 0

@CFShuhrat 0 / 0 / 0 Регистрация: 05.08.2019 Сообщений: 69
	11.09.2019, 06:29 [ТС]	8
	pashulka, Оба кода не копируют лист, а создают пустой лист 0

@CFShuhrat 0 / 0 / 0 Регистрация: 05.08.2019 Сообщений: 69
	11.09.2019, 08:12 [ТС]	10
	pashulka, Вот мой порядок действий: 1. копирую код Test2() с темы 2. создаю модуль в папке Modules в VBAProject (PERSONAL.XLSB) - в новом модуле сверху уже есть строчка Option Explicit - удаляю ее. 3. открыта одна книга, лист не пустой 4. Alt+F8: нет макроса Test2() ни в каких списках 5. удаляю слово Private в коде - макрос появился в списке Personal 6. запускаю макрос - создается новая книга с одним пустым листом 0

@pashulka 4135 / 2239 / 940 Регистрация: 01.12.2010 Сообщений: 4,624
	11.09.2019, 09:08	11
	CFShuhrat, Ещё раз, посмотрите разницу между thisworkbook и activeworkbook 1

@CFShuhrat 0 / 0 / 0 Регистрация: 05.08.2019 Сообщений: 69
	11.09.2019, 10:09 [ТС]	12
	pashulka, Замена ThisWorkbook.ActiveSheet.Copy на ActiveWorkbook.ActiveSheet.Copy в обоих кодах действительно помогла, огромное Вам спасибо! 0