Сохранение текущего листа Excel в отдельный файл

01.10.2008, 17:38. **Показов** 30940. **Ответов** 9

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

Доброго всем времени суток!

Помогите справиться с небольшой проблемкой.
Есть файл Excel с несколькими листами. Сделал ToolBar с кнопками. Как реализовать кнопку "Сохранить как" только для текущего листа. т. е. чтобы при нажатии на кнопку можно было выбрать директорию и имя файла, и текущий лист сохранялся бы в отдельный файл (.html .txt .xls)

Спасибо

P.S. Желательно с примером кода.

@Vlanib · 01.10.2008, 19:34

Сохранение листа в формате вэб страницы:

Visual Basic
1
ActiveWorkbook.PublishObjects.Add(xlSourceSheet, "C:\temp\777.htm", "Лист1").Publish

@Abu · 02.10.2008, 15:50

чтобы при нажатии на кнопку можно было выбрать директорию и имя файла

Пример из API-Guide

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
 
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
 
Dim OFName As OPENFILENAME
 
Private Function ShowSave() As String
    OFName.lStructSize = Len(OFName)
    OFName.hwndOwner = Hwnd
    OFName.hInstance = Application.hInstance
    OFName.lpstrFilter = "html (*.html)" + Chr$(0) + "*.html" + Chr$(0)
    OFName.lpstrFile = Space$(254)
    OFName.nMaxFile = 255
    OFName.lpstrFileTitle = Space$(254)
    OFName.nMaxFileTitle = 255
    OFName.lpstrInitialDir = "C:"
    OFName.lpstrTitle = ""
    OFName.flags = 0
    If GetSaveFileName(OFName) Then
        ShowSave = Trim$(OFName.lpstrFile)
    Else
        ShowSave = ""
    End If
End Function

ну и собственно само сохранение

Visual Basic
1
2
3
4
5
6
7
Private Sub CommandButton1_Click()
    Dim sFile As String
    sFile = ShowSave
    If sFile <> "" Then
        ActiveWorkbook.ActiveSheet.SaveAs Filename:=sFile, FileFormat:=xlHtml 'формат html
    End If
End Sub

ну само собой для .txt FileFormat:=xlText ну и OFName.lpstrFilter = "txt (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) тоже изменить надо будет. И так для всех интересующих форматов.

@Vlanib · 02.10.2008, 18:42

2 Abu:
GetSaveFileName - из пушки по воробьям!

Из хэлпа по VBA:

GetSaveAsFilename Method
Displays the standard Save As dialog box and gets a file name from the user without actually saving any files.

К тому же испрошено было -

...только для текущего листа..

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

Имхо самый оптимальный вариант это копировать необходимый лист в новую книгу и уже её сохранять в заданном формате.

@Abu · 02.10.2008, 20:21

Сообщение от Vlanib

GetSaveFileName - из пушки по воробьям!

так вроде спрашивалось

Сообщение от IpS

чтобы при нажатии на кнопку можно было выбрать директорию и имя файла

Мне диалог в голову и пришёл

P.S. сохраняет и вправду всю книгу, но других вариантов чё то не придумалось

@Vlanib · 03.10.2008, 02:12

Так я и говорю, в Excel есть прекрасный метод для получения имени файла с помощью диалога сохранения: Application.GetSaveAsFilename

@Abu · 05.10.2008, 18:05

Ой! Правда работает! Йа шляпа!

03.11.2008, 14:04

Имееться книга, как сделать чтобы необходимые листы сохранялись в отдельную книгу (например лист счет, догово и ТН-2) при этом название новой книги бралось с номера счета и наименованя плательщика (когда откроете книгу поймете о чем я) Пароль на VBA- 123

04.11.2008, 16:03

Вобщем вроде как проблему с одним листом смог осилить следующим способом

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Private Sub Несохранять()
Dim №СФ As Variant
    Sheets("СчФ").Select       'Открытие листа "СчФ"
    Application.ScreenUpdating = False  'Отключение отображения результатов на экране
With ActiveSheet                        'Переменным присваиваются введенные в бланк данные
    №СФ = .Range("ном").Value
End With
    Sheets("СчФ").Copy Before:=Sheets(1)
    Range("Дат").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
    Range("Поставщик").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
    Range("Плательщик").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
    Range("суммНДС").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
    Range("суммсНДС").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
        'копирование ТН-2 ?
'
'
'
'
'
'
'
 Sheets("СчФ (2)").Select
    Sheets("СчФ (2)").Move
    Sheets("СчФ (2)").Select
    Sheets("СчФ (2)").Name = "СчФ"
    Range("A1").Select
    SavedName = Application.GetSaveAsFilename(InitialFileName:="СчФ_" & №СФ & ".xls", _
    FileFilter:="Рабочие книги (*.xls),*.xls")
    If SavedName = False Then End
    ActiveWorkbook.SaveAs SavedName
    ActiveWindow.Close
    Sheets("СчФ").Select       'Открытие листа "СчФ"
    Application.ScreenUpdating = True
End Sub

Но как в существующую книгу вставить лист "ТН-2"

07.03.2009, 22:40

Код не мой, я только редактировал немного.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub wshSave()
  Dim WbMain As Workbook
    Dim Wb As Workbook
    Dim sh As Worksheet
    Dim DateString As String
    Dim FolderName As String
    Application.EnableEvents = False
    Set WbMain = ActiveWorkbook
    FolderName = WbMain.Path & "\Archive"
    On Error Resume Next
    MkDir FolderName
    If ActiveSheet.Visible = -1 Then
            ActiveSheet.Copy
            Set Wb = ActiveWorkbook
            Wb.SaveAs FolderName _
                      & "\" & Wb.Sheets(1).Name & ".xls"
            Wb.Close False
    End If
    MsgBox "Лист " & ActiveSheet.Name & " в виде отдельного файла сохранён в папку " & FolderName
    ActiveWindow.SelectedSheets.Delete
    Application.EnableEvents = True
End Sub

Новые блоги и статьи Все статьи Все блоги /
PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Access VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .
Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .

@Vlanib Частенько бываю 750 / 331 / 42 Регистрация: 20.06.2007 Сообщений: 854
	03.10.2008, 02:12
	Так я и говорю, в Excel есть прекрасный метод для получения имени файла с помощью диалога сохранения: *Application.GetSaveAsFilename* 0

@Abu 1161 / 288 / 23 Регистрация: 28.09.2008 Сообщений: 553
	05.10.2008, 18:05
	Ой! Правда работает! Йа шляпа! 0