Новости:

Из правил форума: Тема должна отражать суть вопроса, топики типа "help please" будут удаляться!

Главное меню

Примечания

Автор iron priest, 15.11.2009, 16:57

« назад - далее »

iron priest

Можно ли сделать макрос чтобы он на отдельный лист выгружал все примечания в книге и указывал расположение для каждого примечания?


а еще лучше шоб при двойном клике можно было перейти на это примечание?

GWolf

Цитата: iron priest от 15.11.2009, 16:57
Можно ли сделать макрос чтобы он на отдельный лист выгружал все примечания в книге и указывал расположение для каждого примечания?


а еще лучше шоб при двойном клике можно было перейти на это примечание?

Добрый вечер (у нас)!

Сразу скажу - можно. Только, пожалуйста, уточните: - Лист должен создаваться в той же книге из которой делается сборка, или это должна быть отдельная книга, хранящая в себе и макрос и Листы - результаты выгрузки?
Путей к вершине - множество. Этот один из многих!

iron priest

добрый день


да, все должно быть в одном файле

ЗЫ: не люблю связей между книгами

GWolf

#3
Цитата: iron priest от 27.11.2009, 14:43
добрый день


да, все должно быть в одном файле

ЗЫ: не люблю связей между книгами

Я попытался сделать "общий случай" - это когда требуется посмотреть ВЕСЬ лист. У меня получилось вот так:

(Код разместите в стандартном Модуле)

Sub toComment()
   Dim arrCm
   
   
   arrCm = toComm
   
   Stop
End Sub

Function toComm()
   Dim dCell As Range
   Dim arrComm() As String
   Dim txtCom As String, adrs As String
   Dim sct As Long
   
   Set dCel = ThisWorkbook.ActiveSheet.Cells
   
   ReDim arrComm(1)
   txtCom = ""
   adrs = ""
   sct = 0
   
   For Each ch In dCel
       With ch
           If Not .Comment Is Nothing Then
               txtCom = .Comment.Text
               adrs = .Cells.Address
               
               sct = sct + 1
           End If
           
           If txtCom <> "" Then
               If sct = 1 Then
                   ReDim arrComm(1, sct - 1)
               Else
                   ReDim Preserve arrComm(1, sct - 1)
               End If
               
               arrComm(0, sct - 1) = txtCom
               arrComm(1, sct - 1) = adrs
               
               txtCom = ""
               adrs = ""
           End If
       End With
   Next
   
   toComm = arrComm
   
   Erase arrComm
   Set dCel = Nothing
   sct = 0
   txtCom = ""
   adrs = ""
End Function


функция возвращает двумерный массив: первое поле, собственно комментарий, второе - его абсолютный адрес.

Поскольку "смотрится" ВЕСЬ лист, то работает очень долго. Будет быстрее, если ограничить размерами таблицы. Их либо можно определить программно, либо задать в виде координат.

Пока так ... Теперь осталось организовать вставку нового листа, выгрузку на него и формирование гиперссылки на адрес.
Код конечно далек от идеала.
Путей к вершине - множество. Этот один из многих!

GWolf

Вот так окончательно выглядит мое решение.
Путей к вершине - множество. Этот один из многих!

iron priest

спасибо, щас иксел довычисляет и посмотрю

GWolf

Цитата: GWolf от 27.11.2009, 16:51
Вот так окончательно выглядит мое решение.

Можно использовать совместно с этим: https://forum.msexcel.ru/proekty_vba_new/v_primechanii_k_yacheyke_rasshifrovyvaem_ee_soderzhimoe-t2575.0.html
Путей к вершине - множество. Этот один из многих!

iron priest

да сильно вычисляет написанный код :)

iron priest

уж очень долго зараза вычислял. я не сдержался и нажал эскейп. в книге листов 15.

та ссылка на так сказать резиновые примечания мне не очень подходит.

может можно макросу успростить жизнь и задать поиск во всех листах, но только например до 1000-й строки?

GWolf

Цитата: iron priest от 27.11.2009, 20:01
уж очень долго зараза вычислял. я не сдержался и нажал эскейп. в книге листов 15.

та ссылка на так сказать резиновые примечания мне не очень подходит.

может можно макросу успростить жизнь и задать поиск во всех листах, но только например до 1000-й строки?

Уважаемый iron priest! Если Вы скачаете прикрепленный файл, к моему посту: "Вот так окончательно выглядит мое решение.", то там как раз реализовано ограничение диапазона. К сожалению Вы не пишете ничего о структуре Ваших таблиц. Я уже писал, что можно "научить" макрос самостоятельно определять границы таблиц.

Option Base 0

Sub toComment()
    Dim arrCm
    Dim nmSht As String, nmSh As String, forHipS As String
   
    nmSht = ThisWorkbook.ActiveSheet.Name
   
    arrCm = toComm
   
    nmSh = "repComment_" & Format(Date, "yymmdd") & Format(Time, "hhmmss")
    Sheets.Add.Name = nmSh
   
    With Worksheets(nmSh)
        nRTo = 4
        i = 0
        For i = LBound(arrCm, 2) To UBound(arrCm, 2)
            forHipS = ""
            forHipS = nmSht & "!" & arrCm(1, i)
           
            .Cells(nRTo, 1) = arrCm(0, i)
            .Cells(nRTo, 2).Hyperlinks.Add Anchor:=.Cells(nRTo, 2), _
                                           Address:="", _
                                           SubAddress:=forHipS, _
                                           TextToDisplay:=forHipS
            nRTo = nRTo + 1
        Next i
    End With
End Sub

Function toComm()
    Dim dCell As Range
    Dim arrComm() As String
    Dim txtCom As String, adrs As String
    Dim sct As Long
   
    nRIn = 1    ' - номер строки ячейки начала блока
    nCIn = 1    ' - номер колонки ячейки начала блока
    nRTo = 100' - номер строки крайней ячейки блока
    nCTo = 25  ' - номер колонки крайней ячейки блока
   
    With ThisWorkbook.ActiveSheet
        Set dCel = Range(.Cells(nRIn, nCIn), .Cells(nRTo, nCTo))
    End With
   
    ReDim arrComm(1)
    txtCom = ""
    adrs = ""
    sct = 0
   
    For Each ch In dCel
        With ch
            If Not .Comment Is Nothing Then
                txtCom = .Comment.Text
                adrs = .Cells.Address
               
                sct = sct + 1
            End If
           
            If txtCom <> "" Then
                If sct = 1 Then
                    ReDim arrComm(1, sct - 1)
                Else
                    ReDim Preserve arrComm(1, sct - 1)
                End If
               
                arrComm(0, sct - 1) = txtCom
                arrComm(1, sct - 1) = adrs
               
                txtCom = ""
                adrs = ""
            End If
        End With
    Next
   
    toComm = arrComm
   
    Erase arrComm
    Set dCel = Nothing
    sct = 0
    txtCom = ""
    adrs = ""
End Function


вот собственно сам код. В Function toComm() вот эти строки:


    nRIn = 1    ' - номер строки ячейки начала блока
    nCIn = 1    ' - номер колонки ячейки начала блока
    nRTo = 100' - номер строки крайней ячейки блока
    nCTo = 25  ' - номер колонки крайней ячейки блока


собственно "отвечают" за размер "просматриваемого блока ячеек.

Что относительно "резиновой" ячейки, то просто я как бы закруглил ситуацию: - один код позволяет более комфортно (во всяком случае, с моей точки зрения) вводить информацию в примечание. А другой код - собирать ее в некий Реестр или Справочник. Вы можете брать то что Вам подходит. Но, я так думаю, что найдутся те, кому и вторая часть будет интересна.
Путей к вершине - множество. Этот один из многих!

iron priest

что касается структуры таблиц в файле то это финансовая отчетность, то есть 5 форм отчетности (баланс и так далее)+таблицы по анализу фин. состояние.

что касается кода в вашем файле, то мне выдается ошибка(((

я в нем изменил поиск по строке до 1000 и по столбцам до 500

GWolf

Цитата: iron priest от 30.11.2009, 11:21
что касается структуры таблиц в файле то это финансовая отчетность, то есть 5 форм отчетности (баланс и так далее)+таблицы по анализу фин. состояние.

что касается кода в вашем файле, то мне выдается ошибка(((

я в нем изменил поиск по строке до 1000 и по столбцам до 500


Увы! Но столбцов не может быть больше 256-ти!
Путей к вершине - множество. Этот один из многих!

iron priest

хм, странно а у меня 16384


ну окей, поставлю 256, посмотрю

iron priest

поставил 256, всеравно ошибка

тайм ран еррор 9

и в ВБА мне желтым выделило

For i = LBound(arrCm, 2) To UBound(arrCm, 2)

GWolf

Вот что удалось сделать:

В книге, на листе "_" две кнопки: "Старт I" и "Старт II".

  "Старт I" - версия кода для работы с внешней, по отношению к этой книге, книгой. Выбор через окно Проводника. Отчет формируется на листе, вставляемом в запускающую книгу.
  "Старт II" - версия кода для работы "внутри приложения". Копируем код в стандартный модуль книги Вашего приложения и, либо через кнопку (которую создаем сами и на нее подключаем макрос), либо Alt+F8 - запускаем на выполнение. Просматривает все листы активной книги. Вставляет новый лист и на нем формирует таблицу отчета с наименованием отчета и именами колонок таблицы отчета. (Наиболее проработанная версия кода).

   Все остальные листы - тестовые примеры для "Старт II".
Удачи. (В отчетах ранее созданных не ищет!)
Путей к вершине - множество. Этот один из многих!