Переименовать листы в excel по значению ячейки

0 / 0 / 0

Регистрация: 17.06.2013

Сообщений: 13

Господа, помогите нубу
Вот в чем вопрос:
1. Нужно что бы имя листа менялось по имени ячейки.
я находил подобный макрос, но…имя листа почему то менялось только один раз и потом на изменение значение зависимой ячейки больше не реагировало.
2. Нужно сохранить активный лист в формате *pdf. Подчеркиваю, не всю книгу, а только активный лист.
Желательно, что бы макрос можно было повесить на кнопку расположенную на другой странице.
Например:
Кнопка находится на Листе 1, а при нажатии на нее, в *pdf сохраняется Лист 2.
Скажу сразу, моих знаний хватает только на то что бы вставить макрос, редактировать его…увы…извилин не хватает

Pavel55

971 / 353 / 135

Регистрация: 27.10.2006

Сообщений: 764

Перенименование листа.
Набросал на быструю руку, допилите сами

1) откройте любой файл Excel
2) активируйте нужный лист, который вы хотите, чтобы переименовывался по изменению ячейки на этом листе
3) подведите мышку к ярлычку этого листа (слева внизу, где название листа)
4) щёлкните правой клавишей мыши и выберите в контекстном меню «исходный текст»
5) вставьте в открывшееся окно этот код

1
2
3
4
5
6
7
8
9

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target = Range("A1") Then
        If Target.Value <> "" Then
            If Len(Target.Value) < 30 Then
                Target.Parent.Name = Target.Value
            End If
        End If
    End If
End Sub

5) закройте редактор VBA и попробуйте ввести любой текст в ячейку А1 — лист должен переименоваться

P.S. Сюда необходимо добавить функцию, которая будет проверять наличие запрещённых символов (*, / и других)

Экспорт листа в PDF.
Например, нам нужно экспортировать Лист1 в PDF в туже папку, где у нас сейчас находится наш открытый и обязательно сохранённый ранее файл (на несохранённом файле не пробуйте)

1
2
3
4
5
6
7
8
9
10

Sub ExportToPDF()
    Dim sh As Worksheet, iFileName As String
    
    Set sh = ActiveSheet
    iFileName = Replace(ActiveWorkbook.FullName, CreateObject("Scripting.FileSystemObject").GetExtensionName(ActiveWorkbook.Name), "pdf")
    'Sheets(Array("Отчет1", "Отчет2", "Отчет3")).Select
    Sheets("Лист1").Select
    ActiveSheet.ExportAsFixedFormat xlTypePDF, iFileName
    sh.Select
End Sub

P.S. Создаёте кнопку на любом листе и повесьте этот макрос на неё. Укажите в моём коде ваше название нужного листа вместо Лист1

0 / 0 / 0

Регистрация: 17.06.2013

Сообщений: 13

971 / 353 / 135

Регистрация: 27.10.2006

Сообщений: 764

По поводу сохранения в PDF — мой код будет работать, если у вас установлен Excel 2007 и выше. Вроде, только с 2007 офиса есть сохранение в PDF.

По поводу остального ничего не скажу, нужно тестировать на файле

0 / 0 / 0

Регистрация: 17.06.2013

Сообщений: 13

у меня стоит Excel 2010.
Файл выложил на яндекс-диск, Ссылка удалена

971 / 353 / 135

Регистрация: 27.10.2006

Сообщений: 764

1) зачем выкладывать такой большой файл?

2) По поводу экспорта в PDF. Вы ТОЧНО заменили ИМЯ ЛИСТА с ЛИСТ1 на СВОЙ в вашем коде? В вашем файле в коде написано «ЛИСТ1» — а такого листа в вашем файле НЕЕЕЕТ. Либо переименуйте любой ваш лист, например, лист «Форма» на «Лист1«. У меня нормально эспорт срабатывает и в офисе 2010 и в 2013

3) у вас там куча листов. Где что должно выбираться, какой лист должен менять название?

4) По поводу изменения листа по изменению значения в ячейке
Вы ТОЧНО вставли мой код для изменения листа в ваш файл? Где он? В модуле какого листа?

Скачал ваш огромный файл. Предположил (раз вы не сказали какой лист нужен), что вам нужен лист «ФОРМА», вставил свой код в модуль этого листа, долго искал в какой ячейке у вас стоит ПРОВЕРКА, т.к. вы адрес этой ячейки не написали в теме, когда выкладывали файл, заменил в коде адрес ячейки с А1 на I8, попробовал менять значения из выподающего списка в яч. I8 — лист меняет своё имя постоянно, т.е. всё срабатывает хорошо.

Может вам самому вставить нужный код в нужный лист и потестировать? )

0 / 0 / 0

Регистрация: 17.06.2013

Сообщений: 13

Pavel55

971 / 353 / 135

Регистрация: 27.10.2006

Сообщений: 764

для экспорта попробуйте так

1
2
3
4
5
6
7
8
9
10
11

Sub ExportToPDF()
    Dim sh As Worksheet, iFileName As String
    
    Set sh = ActiveSheet
    Application.ScreenUpdating = False
    iFileName = ActiveWorkbook.Path & Application.PathSeparator & Sheets("Форма").Range("I8").Value & ".pdf"
    Sheets(Sheets("Форма").Range("I8").Value).Select
    ActiveSheet.ExportAsFixedFormat xlTypePDF, iFileName
    sh.Select
    Application.ScreenUpdating = True
End Sub

Для переименования (ТОЛЬКО СПЕРВА НАЗАВИТЕ НУЖНЫЙ ЛИСТ ТЕМ НАЗВАНИЕМ, КОТОРОЕ У ВАС В ДАННЫЙ МОМЕНТ УКАЗАНО В ЯЧЕЙКЕ I8 НА ЛИСТЕ «ФОРМА»)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

Dim iCurrentName As String
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     If Target.Address(0, 0) = "I8" Then
        If Target.Cells.Count = 1 Then
            iCurrentName = Target.Value
        End If
     End If
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    On Error Resume Next
    If Target.Address(0, 0) = "I8" Then
        If Target.Value <> "" Then
            If Len(Target.Value) < 30 Then
                Worksheets(iCurrentName).Name = Target.Value
                iCurrentName = Target.Value
            End If
        End If
    End If
End Sub

Добавлено через 13 минут
подкорректировал код

0 / 0 / 0

Регистрация: 17.06.2013

Сообщений: 13

Павел, наверное я что то не так делаю.
Имя листа не реагирует на изменение I8. Предварительно я изменил имя листа как в списке.
а со вторым макросом….у меня не получается сохранить макрос. Создаю макрос — добавляю ваш макрос-и сохраняю. А когда пытаюсь повесить макрос на кнопку то его нет в списке макросов.

Добавлено через 12 минут
С макросом Экспорта разобрался немного. Но все равно ругается на эту строку
Sheets(Sheets(«Форма»).Range(«I8»).Value).Select.
а с переименованием так ничего и не получается

Добавлено через 12 минут
Ураа, заработало))
трудно быть деревянным
Павел, я нашел что делал не так. Переименовать страницы по списку заработало.
Осталась проблема только с экспортом. Но без вашей помощи я не найду почему ругается на эту строку.

971 / 353 / 135

Регистрация: 27.10.2006

Сообщений: 764

0 / 0 / 0

Регистрация: 17.06.2013

Сообщений: 13

Pavel55

971 / 353 / 135

Регистрация: 27.10.2006

Сообщений: 764

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

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

Sub ExportToPDF()
    Dim iFileName As String, iShtName As String, iPath As String, FD As FileDialog
    
    Application.ScreenUpdating = False
    'iFileName = ActiveWorkbook.Path & Application.PathSeparator & Sheets("Форма").Range("I8").Value & ".pdf"
    iFileName = Sheets("Форма").Range("I8").Value & ".pdf"
    iShtName = Sheets("Форма").Range("I8").Value
    If iShtName = "" Then
        MsgBox "Не указана модель на листе 'Форма' в ячейке I8", vbExclamation, "Ошибка"
        Exit Sub
    End If
   
    Set FD = Application.FileDialog(msoFileDialogFolderPicker)
    With FD
        .InitialFileName = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, Application.PathSeparator, -1, vbTextCompare))
        .InitialView = msoFileDialogViewList
        .AllowMultiSelect = False
        .Title = "Укажите папку для сохранения"
        .ButtonName = "Выбрать папку"
        If .Show = False Then Exit Sub Else iPath = .SelectedItems(1) & Application.PathSeparator
    End With
    Set FD = Nothing
    
    If SheetExist(iShtName) Then
        Worksheets(iShtName).ExportAsFixedFormat xlTypePDF, iPath & iFileName
    Else
        Application.ScreenUpdating = True
        MsgBox "Лист с названием '" & iShtName & "' отсутствует в книге!", vbExclamation, "Ошибка"
        Exit Sub
    End If
    Application.ScreenUpdating = True
    MsgBox "Файл сохранён в " & iPath & iFileName, vbInformation, "Экспорт в PDF"
    
End Sub
 
Function SheetExist(iName As String) As Boolean
    On Error Resume Next
    With Worksheets(iName): End With
    SheetExist = (Err = 0)
    Err.Clear
End Function

по поводу «очему при сохранении файла или при печати — вместе с пятью страницами текста захватывается в печать несколько пустых страниц» — я, к сожалению, не знаю

0 / 0 / 0

Регистрация: 17.06.2013

Сообщений: 13

Миниатюры

Аксима

6076 / 1320 / 195

Регистрация: 12.12.2012

Сообщений: 1,023

Edvin, проблема не в этом.

Сделал чуть более надежное решение. Благодарности — Pavel55, ведь за основу был взят его код.

В модуль нужного листа

1
2
3
4
5
6
7
8
9
10
11
12
13
14

Private Sub Worksheet_Activate()
    iCurrentName = ActiveSheet.Name
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "I8" Then
        If Target.Value <> "" Then
            If Len(Target.Value) < 30 Then
                Worksheets(iCurrentName).Name = Target.Value
                iCurrentName = Target.Value
            End If
        End If
    End If
End Sub

В модуль ThisWorkbook («ЭтаКнига»)

1
2
3

Private Sub Workbook_Open()
    iCurrentName = ActiveSheet.Name
End Sub

В модуль общего назначения (объявить в самом верху)

1

Public iCurrentName As String

P.S. В данном решении не обязательно, чтобы значение ячейки «I8» целевого листа совпадало с названием листа перед вставкой кода.

С уважением,

Aksima

0 / 0 / 0

Регистрация: 17.06.2013

Сообщений: 13

6076 / 1320 / 195

Регистрация: 12.12.2012

Сообщений: 1,023

Edvin, попробую объяснить с помощью картинки. См. ниже.

С уважением,

Aksima

Миниатюры

0 / 0 / 0

Регистрация: 08.12.2015

Сообщений: 4

Sub ExportToPDF()
Dim sh As Worksheet, iFileName As String

Set sh = ActiveSheet
Application.ScreenUpdating = False
iFileName = ActiveWorkbook.Path & Application.PathSeparator & Sheets(«Форма»).Range(«I8»).Value & «.pdf»

Sheets(Sheets(«Форма»).Range(«I8»).Value).Select
ActiveSheet.ExportAsFixedFormat xlTypePDF, iFileName
sh.Select
Application.ScreenUpdating = True
End Sub

Почему останавливается макрос на выделенном коде. Использую Ofice 2007. Важно именно такое решение, сохранять активный лист «Форма» в файле PDF с присвоением ему имени из данных в ячейке «I8». Кто подскажет решение ?

k61

85 / 82 / 31

Регистрация: 13.10.2014

Сообщений: 167

Очевидно нет в книге листа с именем указанным в ячейке «I8» листа «Форма».
Так попробуйте:

1
2

'Sheets(Sheets("Форма").Range("I8").Value).Select
Sheets("Форма").Select

0 / 0 / 0

Регистрация: 08.12.2015

Сообщений: 4

Да, действительно нет, и не надо переименовывать лист по названию ячейки. Лист «Форма», он не переименовывается, но в нем есть ячейка «I8», в которой изменяются данные. Вот эти данные и должны быть в названии файла PDF при сохранении листа «Форма»

Добавлено через 56 минут
Sub ExportToPDF()
Dim sh As Worksheet, iFileName As String
Set sh = ActiveSheet
iFileName = Replace(ActiveWorkbook.FullName, CreateObject(«Scripting.FileSystemObject»).GetExte nsionName(ActiveWorkbook.Name), «pdf»)
Sheets(«Лист1»).Select
ActiveSheet.ExportAsFixedFormat xlTypePDF, iFileName
sh.Select
End Sub

Этот код работает корректно, но сохраняет в PDF всегда одно и тоже название книги, без изменений.

pashulka

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

Без необходимых проверок :

1
2
3
4

Private Sub Test()
    iFileName$ = ActiveWorkbook.Path & "" & Worksheets("Форма").Range("I8") & ".pdf"
    ActiveSheet.ExportAsFixedFormat xlTypePDF, iFileName$
End Sub

1
2
3
4
5

Private Sub Test2()
    With ActiveWorkbook
         .ActiveSheet.ExportAsFixedFormat xlTypePDF, .Path & "" & .Worksheets("Форма").[I8]
    End With
End Sub