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

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

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

Visual Basic    
        
            
                
                
                
                
            
        
    Скопировано
1
2
3
4
5
6
7
8
9
10
11
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    
        
    Скопировано
1
2
3
4
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    
        
            
                
                
                
                
            
        
    Скопировано
1
2
3
4
5
6
7
8
9
10
11
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    
        
            
                
                
                
                
            
        
    Скопировано
1
2
3
4
5
6
7
8
9
10
11
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    
        
            
                
                
                
                
            
        
    Скопировано
1
2
3
4
5
6
7
8
9
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 в обоих кодах действительно помогла, огромное Вам спасибо!

Новые блоги и статьи Все статьи Все блоги /
Миграция монолита в Event-Driven микросервисную архитектуру на C# stackOverflow 11.04.2025 Монолитная архитектура – классический подход к разработке программного обеспечения. Это приложение, построенное как единое целое, где все компоненты тесно связаны между собой. Большинство проектов. . .	Go в Kubernetes: Управление ресурсами golander 11.04.2025 Разработчики Go-приложений в Kubernetes часто сталкиваются с неожиданными проблемами производительности и даже внезапными отказами контейнеров. Причина этого кроется в особенностях взаимодействия. . .	Агрегаты и сущности в DDD микросервисах Javaican 10.04.2025 Разработка современных программных систем часто приводит на распутье: монолит или микросервисы? Даже при выборе микросервисной архитектуры многие команды сталкиваются с проблемой правильного. . .	Многопоточность в C#: Task и параллельное программирование UnmanagedCoder 10.04.2025 Современные процессоры уже давно перестали наращивать тактовую частоту в пользу увеличения количества ядер. Это создало интересную ситуацию: разработчики, привыкшие к последовательному. . .	Линейное решение нелинейной задачи будет иметь приблизительный результат вычисления для метода обработки данных из double buffering. Hrethgir 10.04.2025 Вообще изначально я пренебрёг квадратурой числа, но потом понял, что для вычисления приблизительного значения - сгодится, формулу можно будет корректировать по ходу. Это потому что прямое соотношение. . .
Переменные в Python py-thonny 10.04.2025 Переменная в программировании — это символическое имя, связанное с областью памяти, в которой хранится значение. Она позволяет получать доступ к данным через понятные человеку идентификаторы, а не. . .	Многопоточность в C#: Task и асинхронные операции UnmanagedCoder 10.04.2025 Многопоточность позволяет выполнять несколько операций одновременно, что важно для решения двух основных задач: повышения скорости выполнения вычислительно-сложных операций и сохранения отзывчивости. . .	Запуск контейнеров Docker на ARM64 Mr. Docker 09.04.2025 Появление таких решений, как Apple M1/ M2, AWS Graviton, Ampere Altra и Raspberry Pi, сделало использование ARM-систем обыденностью для многих разработчиков и DevOps-инженеров. При этом Docker,. . .	Vue SFC компонент на PHP с Fusion Jason-Webb 09.04.2025 PHP на сервере и JavaScript на клиенте — классическое сочетание, которое, несмотря на свою эффективность, создает определенный когнитивный диссонанс при разработке. В этом контексте появляются. . .	TypeScript vs JavaScript: Отличия и когда что использовать Reangularity 09.04.2025 JavaScript появился в 1995 году как творение Брендана Эйха и быстро стал основой интерактивности в вебе. За свою историю он прошел путь от простого языка для манипуляций с DOM до полноценной. . .

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

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

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

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

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

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

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