Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.02.2013, 10:43   #1
w00t
Пользователь
 
Регистрация: 15.03.2012
Сообщений: 29
По умолчанию Небольшая правка vba - оглавление со второй строки

Прошу помощи с:

макрос в листе TOC создает оглавление. Как можно поправить макрос, чтобы оглавление создавалось со со второй строки, игнорируя первую полностью. И при этом в первую строку можно было вводить что угодно и изменять как угодно - макрос на нее не реагировал.

Т.к. в оглавлении хочется сделать еще описание категорий вида: Ячейка A1 - "Наименование листа", Ячейка B1 - "Описание отчета", Ячейка C1 - "Актуальность отчета".
Вложения
Тип файла: zip TOC.zip (18.8 Кб, 10 просмотров)
w00t вне форума Ответить с цитированием
Старый 13.02.2013, 11:34   #2
mrMeerkat
Следопыт
Форумчанин
 
Аватар для mrMeerkat
 
Регистрация: 26.04.2012
Сообщений: 350
По умолчанию

В конце макроса напишите строчку на добавление новой строки перед первой.
(не открываю чужие документы с макросами, вдруг неправильно понял)
С Баша:Быть ленивым, глупым, жадным, да и просто редкостным гандоном и мудаком по жизни номально, а вот если ты матом ругаешься-то это да, ужасно и достойно общественного порицания.
mrMeerkat вне форума Ответить с цитированием
Старый 13.02.2013, 12:02   #3
w00t
Пользователь
 
Регистрация: 15.03.2012
Сообщений: 29
По умолчанию

Цитата:
Сообщение от mrMeerkat Посмотреть сообщение
В конце макроса напишите строчку на добавление новой строки перед первой.
(не открываю чужие документы с макросами, вдруг неправильно понял)
Не совсем простая ситуация, сам набор макросов с исходного кода страницы оглавление:

Код:
Option Explicit

Private Function SheetExists(ByVal SheetName As String, _
    Optional ByVal WB As Workbook = Nothing) As Boolean
  'True if sheet SheetName exists
  On Error Resume Next
  If WB Is Nothing Then Set WB = ActiveWorkbook
  SheetExists = Not WB.Sheets(SheetName) Is Nothing
End Function

Private Sub Worksheet_Activate()
  'Updates the TOC
  Dim Sh As Object
  Dim R As Range, All As Range
  Dim Temp(), i As Long
  Dim Changed As Boolean
 
  'Step 1: Add missing sheet names to the TOC

  'Visit each sheet
  For Each Sh In ThisWorkbook.Sheets
    'Skip ourself
    If Sh.Name <> Me.Name Then
      'Find the name in column A
      Set R = Columns("A").Find(Sh.Name, LookIn:=xlValues, LookAt:=xlWhole)
      'Found?
      If R Is Nothing Then
        'Add it below
        Set R = Range("A" & Rows.Count).End(xlUp).Offset(1)
        R = Sh.Name
        'Remember that a change has occurred
        Changed = True
      End If
    End If
  Next

  'Step 2: Remove none existing sheet names from the TOC

  'Visit each used cell in column A
  For Each R In Range("A1", Range("A" & Rows.Count).End(xlUp))
    'Does a sheet with this name exists?
    If Not SheetExists(R.Value, ThisWorkbook) Then
      'No, remember this cell
      If All Is Nothing Then Set All = R Else Set All = Union(All, R)
    End If
  Next
  'Delete cells with invalid sheet names if necessary
  If Not All Is Nothing Then
    All.EntireRow.Delete
    'Remember that a change has occurred
    Changed = True
  End If
 
  'Step 3: Sort the TOC in the same order as the sheet appear

  'Create an array for all sheet names and store the names
  ReDim Temp(1 To ThisWorkbook.Sheets.Count - 1)
  For Each Sh In ThisWorkbook.Sheets
    If Sh.Name <> Me.Name Then
      i = i + 1
      Temp(i) = Sh.Name
      If Cells(i, 1) <> Temp(i) Then
        'Remember that a change has occurred
        Changed = True
      End If
    End If
  Next
  'No change, sorting is superfluous
  If Not Changed Then Exit Sub

  'Add as custom list
  Application.AddCustomList Temp

  'Sort the cells with this order
  Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Header:=xlNo, _
    OrderCustom:=Application.CustomListCount + 1, Orientation:=xlSortColumns

  'Delete the custom list
  If Val(Application.Version) > 11 Then ActiveSheet.Sort.SortFields.Clear
  Application.DeleteCustomList Application.CustomListCount
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  'Add a new sheet with that name
  Dim WS As Worksheet
 
  'Only if one cell is selected
  If Target.Count > 1 Or Target.Areas.Count > 1 Then Exit Sub
  'And only in column A
  If Target.Column > 1 Then Exit Sub
  If Not SheetExists(Target.Value, ThisWorkbook) Then
    Set WS = Worksheets.Add(After:=Sheets(Sheets.Count))
    WS.Name = Target.Value
    'Create a hyperlink to the TOC in the new sheet
    WS.Hyperlinks.Add WS.Range("A1"), "", Me.Range("B1").Address(External:=True), _
      TextToDisplay:="Оглавление"
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  'Switch to the selected sheet name
 
  'Only if one cell is selected
  If Target.Count > 1 Or Target.Areas.Count > 1 Then Exit Sub
  If Target.Column > 1 Then Exit Sub
  If SheetExists(Target.Value, ThisWorkbook) Then
    'Select the cell to the right
    Application.EnableEvents = False
    Target.Offset(, 1).Select
    Application.EnableEvents = True
    'Go to that sheet
    Sheets(Target.Value).Select
  End If
End Sub
В исходном коде "Эта книга":

Код:
Public sh_count As Integer

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ThisWorkbook.Sheets.Count < sh_count Then Call Переход_в_Оглавление
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
sh_count = ThisWorkbook.Sheets.Count
End Sub
И, наконец, модуль микро..
Код:
Sub Переход_в_Оглавление()
Worksheets("Оглавление").Select
End Sub
Иных макросов там нет. Дело в том, что как заставить все реагировать на первую пустую строку в оглавлении - никак совсем не реагировать. Создать ее не вопрос, чтобы со второй оглавление создавалось. Но Как только вводятся данные в первую пустую - прочие модули реагируют..

Последний раз редактировалось w00t; 13.02.2013 в 12:11.
w00t вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Оглавление посредством VBA? tolikman Microsoft Office Word 3 15.10.2014 14:51
[Ассемблер] Нужна небольшая правка. JinYa Помощь студентам 0 23.09.2011 21:06
Создать оглавление vba Lyudm Microsoft Office Excel 19 18.12.2010 02:46
считать из файла две строки, вывести на экран символы первой строки, которые отсутствуют во второй gotex Помощь студентам 4 08.05.2008 02:27