Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Приревание выбранной связи через VBA / 14 сообщений из 14, страница 1 из 1
17.11.2009, 13:52
    #36314827
kaol
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Приревание выбранной связи через VBA
Здравствуйте.

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

Спасибо, Ольга
...
Рейтинг: 0 / 0
17.11.2009, 14:44
    #36314945
Djon Player
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Приревание выбранной связи через VBA
kaolЗдравствуйте.

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

Спасибо, Ольга

Код: plaintext
1.
ThisWorkbook.BreakLink Name:="Book_1", Type:=xlExcelLinks
...
Рейтинг: 0 / 0
17.11.2009, 18:27
    #36315629
kaol
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Приревание выбранной связи через VBA
Djon Player,

не работает, я так уже пробовала
...
Рейтинг: 0 / 0
17.11.2009, 19:26
    #36315739
ZVI
ZVI
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Приревание выбранной связи через VBA
Ольга, попробуйте так:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
Sub Test()
  Dim lnk
  With ThisWorkbook
    For Each lnk In .LinkSources(Type:=xlLinkTypeExcelLinks)
      If InStr( 1 , lnk, "\Book_1.xl",  1 ) Then .BreakLink lnk, xlLinkTypeExcelLinks
      If InStr( 1 , lnk, "\Book_2.xl",  1 ) Then .BreakLink lnk, xlLinkTypeExcelLinks
    Next
  End With
End Sub
...
Рейтинг: 0 / 0
18.11.2009, 12:29
    #36316973
Djon Player
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Приревание выбранной связи через VBA
kaolDjon Player,

не работает, я так уже пробовала

Зайдите в меню Правка, Связи и проверьте, активна ли у вас кнопка "Разорвать связи".
Если активна, попробуйте выделить нужный файл и нажать разорвать связи.
Если связь не будет разорвана, то скорее всего есть как минимум одна связь на защищенном листе по этой-же причине и код не разрывает связь.
Тогда нужно предварительно делать снятие защиты нужных листов, где встречается данная связь и потом указывать код
Код: plaintext
ThisWorkbook.BreakLink Name:="Book_1", Type:=xlExcelLinks
Если кнопка не активна, добавьте пустой лист в этом файле и с него зайдите в меню Правка, Связи.
И повторите пункты написанные выше.
...
Рейтинг: 0 / 0
20.11.2009, 10:30
    #36321638
kaol
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Приревание выбранной связи через VBA
ZVI,

Вот мой код, но почему-то не прерывает связь.

Private Sub CommandButton2_Click()
Dim lnk

Sheets("ÊÓ").Select
Sheets("ÊÓ").Copy /Копирование выбранного листа в отдельную книгу

Msg = MsgBox("Ïðåðâàòü ñâÿçü", 4)
If Msg = vbYes Then


With ThisWorkbook /Прерывание связи этого листа с книгой, из которой он был скопирован
For Each lnk In .LinkSources(Type:=xlLinkTypeExcelLinks)
If InStr(1, lnk, "\1.xl", 1) Then .BreakLink lnk, xlLinkTypeExcelLinks
If InStr(1, lnk, "\2.xl", 1) Then .BreakLink lnk, xlLinkTypeExcelLinks
Next
End With

Else
End If
ActiveSheet.Shapes("CommandButton1").Select
Selection.Delete
ActiveSheet.Shapes("CommandButton2").Select
Selection.Delete

Msg = MsgBox("Îòïðàâèòü ïî ïî÷òå?", 4)
If Msg = vbYes Then
Application.Dialogs(xlDialogSendMail).Show / Это вопрос, а не комментарий. Как присвоить новое имя файла, не Книга 1, а Командировочное удостоверение. Те фаил должен отправляться по почте под именем Командировочное удостоверение. Возможно, переименовывать нужно раньше.
Else

End If

End Sub

Спасибо вам заранее, Ольга
...
Рейтинг: 0 / 0
20.11.2009, 10:43
    #36321672
Игорь Горбонос
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Приревание выбранной связи через VBA
> Автор: kaol
> Это вопрос, а не комментарий. Как присвоить новое имя файла, не Книга 1, а Командировочное удостоверение. Те фаил
> должен отправляться по почте под именем Командировочное удостоверение. Возможно, переименовывать нужно раньше.

Я знаю 2 способа.
Первый - сохранить книгу под нужным именем
и второй создать книгу на основе файла с нужным именем, например:
Код: plaintext
Application.Workbooks.Add "Путь к файлу с нужным именем"
В результате если "Путь к файлу с нужным именем" это была строка вида: c:\Командировочное удостоверение.xls создатся
файл с именем "Командировочное удостоверение1".

З.Ы. И используй тег SRC для оформления кода

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
20.11.2009, 10:46
    #36321684
Djon Player
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Приревание выбранной связи через VBA
kaol
Вот мой код, но почему-то не прерывает связь.
Не могли бы вы выложить код в правильной кодировке, а то вместо русских букв иероглифы.
...
Рейтинг: 0 / 0
20.11.2009, 10:54
    #36321709
Djon Player
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Приревание выбранной связи через VBA
kaol
Думаю что основная проблема в использовании ThisWorkbook в данном коде:
Код: plaintext
1.
2.
With ThisWorkbook /Прерывание связи этого листа с книгой, из которой он был скопирован
End With
Т.к. ThisWorkbook означает книгу в которой работает данный макрос, а у вас как я понимаю связь получается в новой книге.

Лучше приложите оригинал файла, так будет проще.
...
Рейтинг: 0 / 0
20.11.2009, 11:03
    #36321727
kaol
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Приревание выбранной связи через VBA
Djon Player,

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
Private Sub CommandButton2_Click()
Dim lnk

Sheets("КУ").Select 
Sheets("КУ").Copy ' Копирование выбранного листа в новую книгу


Msg = MsgBox("Прервать связь",  4 )
If Msg = vbYes Then


With ThisWorkbook
For Each lnk In .LinkSources(Type:=xlLinkTypeExcelLinks)
If InStr( 1 , lnk, "\1.xl",  1 ) Then .BreakLink lnk, xlLinkTypeExcelLinks
If InStr( 1 , lnk, "\2.xl",  1 ) Then .BreakLink lnk, xlLinkTypeExcelLinks
Next
End With

Else
End If
ActiveSheet.Shapes("CommandButton1").Select
Selection.Delete
ActiveSheet.Shapes("CommandButton2").Select
Selection.Delete

Msg = MsgBox("Отправить по почте",  4 )
If Msg = vbYes Then
Application.Dialogs(xlDialogSendMail).Show

Else

End If

End Sub

...
Рейтинг: 0 / 0
20.11.2009, 11:04
    #36321728
Djon Player
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Приревание выбранной связи через VBA
kaol,

Так-же смущает использование такой конструкции:
Код: plaintext
1.
2.
If InStr( 1 , lnk, "\1.xl",  1 ) Then .BreakLink lnk, xlLinkTypeExcelLinks
If InStr( 1 , lnk, "\2.xl",  1 ) Then .BreakLink lnk, xlLinkTypeExcelLinks
Это предполагает, что имена ваших файлов начинаются на "1.xl" и "2.xl", в то время как вы писали, что в у вас Book_1 и Book_2.
Да и по умолчанию в русской версии Книга1, Книга2, ни то ни другое не подпадает под эту проверку.
Более правильно указать конкретные имена файлов, которые можно получить с помощью кода.
...
Рейтинг: 0 / 0
20.11.2009, 11:07
    #36321738
kaol
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Приревание выбранной связи через VBA
kaol,


У меня все получилось. Я изменила эту книгу на активну.

Всем спасибо.
...
Рейтинг: 0 / 0
20.11.2009, 11:46
    #36321832
ZVI
ZVI
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Приревание выбранной связи через VBA
На всякий случай полный код:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
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

...
Рейтинг: 0 / 0
20.11.2009, 11:48
    #36321842
ZVI
ZVI
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Приревание выбранной связи через VBA
Комментарии "вместо 1..." проигнорируйте
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Приревание выбранной связи через VBA / 14 сообщений из 14, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]