Приревание выбранной связи через VBA

Узнай цену своей работы

Формулировка задачи:

Здравствуйте.
У книги есть связь с двумя книгами, например Book_1 и Book_2.
Как будет выглядить программный код, если я хочу прервать связь с Book_1
Спасибо, Ольга

Решение задачи: «Приревание выбранной связи через VBA»

textual
Листинг программы
<font color="blue">Private</font> <font color="blue">Sub</font> CommandButton2_Click()
  SendSheet
<font color="blue">End</font> <font color="blue">Sub</font>

<font color="blue">Sub</font> SendSheet()
  <font color="blue">Dim</font> Lnk, TmpFileName
  <font color="00AA00">' Имя листа-источника, вместо 1 впишите <font color="teal">"ИмяЛистаКомандировки"</font></font>
  <font color="blue">Const</font> SrcSheetName = <font color="teal">"КУ"</font>
  <font color="blue">Const</font> DestWbName = <font color="teal">"Командировочное_удостоверение.XLS"</font>
  <font color="00AA00">' Временный файл</font>
  TmpFileName = Environ(<font color="teal">"Temp"</font>) & <font color="teal">"\"</font> & DestWbName
  <font color="00AA00">' Ловушка для ошибок</font>
  <font color="blue">On</font> <font color="blue">Error</font> <font color="blue">GoTo</font> if_error
  <font color="00AA00">' Скопировать лист в новую книгу. Вместо (1) впишите (<font color="teal">"ИмяЛиста"</font>)</font>
  ThisWorkbook.Sheets(SrcSheetName).Copy
  <font color="00AA00">' Подготовить копию команд. удост.</font>
  <font color="blue">With</font> ActiveWorkbook
    <font color="00AA00">' Удалить все связи</font>
    <font color="blue">For</font> <font color="blue">Each</font> Lnk <font color="blue">In</font> .LinkSources(<font color="blue">Type</font>:=xlLinkTypeExcelLinks)
      .BreakLink Lnk, xlLinkTypeExcelLinks
    <font color="blue">Next</font>
    <font color="00AA00">' Удалить 2 кнопки</font>
    ActiveSheet.Shapes(<font color="teal">"CommandButton1"</font>).Delete
    ActiveSheet.Shapes(<font color="teal">"CommandButton2"</font>).Delete
    <font color="00AA00">' Сохранить с требуемым именем и закрыть</font>
    .SaveCopyAs TmpFileName
    .<font color="blue">Close</font> False
  <font color="blue">End</font> <font color="blue">With</font>
  <font color="00AA00">' Загрузить для чтения</font>
  <font color="blue">With</font> Workbooks.<font color="blue">Open</font>(TmpFileName)
    Application.DisplayAlerts = False
    .ChangeFileAccess xlReadOnly
    Application.DisplayAlerts = True
  <font color="blue">End</font> <font color="blue">With</font>
  <font color="00AA00">' Удалить временный файл</font>
  <font color="blue">Kill</font> TmpFileName
  <font color="00AA00">' Послать и закрыть</font>
  <font color="blue">If</font> MsgBox(<font color="teal">"Send it?"</font>, vbInformation + vbYesNo, <font color="teal">"Командировочное удостоверение"</font>) = vbYes <font color="blue">Then</font>
    Application.Dialogs(xlDialogSendMail).Show
    Workbooks(DestWbName).<font color="blue">Close</font> False
  <font color="blue">End</font> <font color="blue">If</font>
  <font color="blue">Exit</font> <font color="blue">Sub</font>
if_error:
  MsgBox Err.Description, vbCritical, <font color="teal">"Error "</font> & Err.Number
<font color="blue">End</font> <font color="blue">Sub</font>

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

11   голосов , оценка 3.909 из 5