Новости:

К первому сообщению темы должен быть прикреплен файл примера в формате xls*.
Приложив пример, Вы избавите себя и других от вопросов типа "А какой критерий?", "А куда выводить результат?", "А сколько строк?" и все тех же просьб выложить файл. Рисовать за Вас Ваши же таблички с заданиями, а затем и решение к ним, никто желанием не горит. Да и, как показывает практика, в большинстве случаев без файла решения не найти.

Главное меню

Удаление связей с другими книгами после обработки макросом

Автор Станиславский, 27.02.2018, 12:52

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

Станиславский

Доброго времени суток!
Возникла такая интересная проблема: есть рабочий файл, в который сливается куча инфы и обрабатывается макросом...дальше специфика))
так вот, после обработки определённого объёма, есть необходимость сохранить один лист из рабочего файла в виде отчёта. т.е. просто скопировать этот лист как отдельную книгу и убрать все ссылки и формулы, что собственно макрос и делает, но, когда открываешь получившийся файл, выскакивает сообщение на обновление данных. При этом все ссылки, формулы и т.д. убраны! Есть подозрение, что остаётся привязка форматов...
Вопрос - как можно убрать данное оповещение или на моменте формирования итогового отчёта убрать полностью все привязки, чтоб этого сообщения и не было.
p.s. если зайти данные-изменить связи, то, действительно, показывает, что есть связь с рабочим файлом, но изменить её или разорвать нет возможности (т.е. он как бы предлагает разорвать, но ничего не происходит)
p.p.s. макрос перемещает нужный лист копированием и созданием новой книги, выделяет всё на листе и вставляет как значения, потом даёт имя этой книге.

boa

Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Станиславский

Та я бы и вложил, только непонятно что вкладывать. Делаю пример файла - проблемы такой нет, а выкладывать весь файл с конфиденциальной информацией, сами понимаете :)
Разве что макрос приложу:
Sub Макрос1()
    Sheets("Отчёт").Select
    Sheets("Отчёт").Copy
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J22").Select
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
        "Y:\Отчёты\Продажи февраль.xlsx", FileFormat _
        :=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
End Sub

boa

когда новая книга у вас создастся, выполните следующий макрос для разрыва связей в активновой книге

Sub DelLink()
'удаляет связи с другими книгами
    Dim WbLinks, i&
    WbLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
    If IsArray(WbLinks) Then
        For i = LBound(WbLinks) To UBound(WbLinks)
            ActiveWorkbook.BreakLink Name:=WbLinks(i), Type:=xlLinkTypeExcelLinks
        Next i
    Else
        MsgBox "В данной книге нет ссылок на другие книги"
    End If
End Sub
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Станиславский

я правильно понимаю, что данный макрос проверяет есть ли ссылки на другие книги и, если есть, то удаляет их?
и его надо запускать в новой книге? но, вся суть, чтоб новая книга была без макросов ссылок и прочего...т.е. просто книга с одним листом.
я подозреваю, что, возможно, тянутся форматы таблиц (заливка, границы и шрифты)

boa

да правильно.
для того чтобы данный макрос запустить, не обязательно его копировать в новую книгу. Достаточно, что бы новая книга была активна.
а ваши "подозрения" так и останутся в силе, ибо вариантов много(и заливка, границы и шрифты тут не при чем), а истина одна(без "пациента" можно гадать долго).
Могу предположить, что у вас копируется какой-то скрытый объект имеющий ссылку на книгу-источник.
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

boa

Из персональной коллекции: Макрос копирующий выделенный диапазон в новую книгу


Sub SelectedCopyInNewBook()
' Макрос записан 27-28.10.2015 (boa)
' Копирование видимого выделенного диапазона в новую книгу
' Так же переносит масштаб и границы фриза

    Dim a As Range
    'Запоминаем масштаб окна, что бы повторить его в новой книге
    Dim ZoomAW%: ZoomAW = ActiveWindow.Zoom
    'Запоминаем название листа, что бы повторить его в новой книге
    Dim shName$: shName = ActiveWorkbook.ActiveSheet.Name
    'определяем зафризенную строку и колонку, что бы сразу зафризить их в новой книге
    Dim FreezeRow&: FreezeRow = ActiveWindow.SplitRow
    Dim i& ': i = 1
    For Each a In Selection.Rows
        If Not a.Hidden Then
            i = i + 1
            If a.Row > FreezeRow Then Exit For
            If a.Row = FreezeRow Then FreezeRow = i: Exit For
        End If
    Next
    Dim FreezeCol&: FreezeCol = ActiveWindow.SplitColumn
    Dim j& ': j = 1
    For Each a In Selection.Columns
        If Not a.Hidden Then
            j = j + 1
            If a.Column > FreezeCol Then Exit For
            If a.Column = FreezeCol Then FreezeCol = j: Exit For
        End If
    Next
   
    With Application
        .Selection.SpecialCells(xlCellTypeVisible).Copy    'копируем только видимые ячейки в выделенной области
        .Workbooks.Add(xlWBATWorksheet).Worksheets(1).Name = shName
        .ActiveSheet.Paste
        .Selection.PasteSpecial Paste:=xlPasteColumnWidths   'вставляем ширину скопированных колонок
        .Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats 'вставляем формат и значения
        .CutCopyMode = False
        With .ActiveWindow
            If FreezeRow = i Then .SplitRow = FreezeRow
            If FreezeCol = j Then .SplitColumn = FreezeCol
            If .SplitRow > 0 Or .SplitColumn > 0 Then .FreezePanes = True
            .Zoom = ZoomAW
        End With
    End With
End Sub

Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Станиславский

Вот и "пациент" слегка похудевший, но сам итоговый макрос остался (кнопка "Готово")

boa

Вот и единственное решение
в менеджере имен Ctrl+F3 удалите имена или перелинкуйте на актуальный файл
или выполните макрос
Sub All_Names_Delete()
'   удалить все имена в книге
    On Error Resume Next
    Dim objName As Object
    For Each objName In ActiveWorkbook.Names
        objName.Delete
    Next objName
End Sub
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Станиславский

УРА! Спасибо! Проблема, вроде решена (ещё есть пару таких файлов-дублёров, пойду их крушить)
p.s. вот, что значит свежий взгляд)) ещё раз спасибо!

boa

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

Станиславский

Та я то, вроде, тоже думал, что знаю куда смотреть, когда на работе своим по экселю помогаю, но оказалось, что ещё впереди куча всего неизведанного и интересного! :)
Ещё раз спасибо!
p.s. уже "облегчил" много подобных файлов :)