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