Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Подсказка на ячейку через гиперссылку не дружит с последующим форматом по образцу
 
#1
26.08.2026 15:35:07
Ребята, доброго дня.
Подскажите пожалуйста что тут не так:
Код
Sub Макрос1()
    ActiveSheet.Hyperlinks.Add Anchor:=Range("tblMaket[[#Headers],[ПДН]]"), Address:="", SubAddress:="SMT!G1", ScreenTip:="text text"
    Range("tblMaket[[#Headers],[код]]").Select
    Selection.Copy
    Range("tblMaket[[#Headers],[ПДН]]").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub
Если разделить макрос на два:
Код
Sub Макрос_1()
    ActiveSheet.Hyperlinks.Add Anchor:=Range("tblMaket[[#Headers],[ПДН]]"), Address:="", SubAddress:="SMT!G1", ScreenTip:="text text"
End Sub
и
Код
Sub Макрос_2()
    Range("tblMaket[[#Headers],[код]]").Select
    Selection.Copy
    Range("tblMaket[[#Headers],[ПДН]]").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub
и сразу выполнить 1-й, потом 2-й, то всё работает, а одним макросом не получается.
Выдаёт ошибку: method range of object global failed
Изменено: AndreiSMT - 26.08.2026 15:35:43
 
 
 
#2
26.08.2026 17:11:54
Лучше опишите саму ЗАДАЧУ, а не проблемный СПОСОБ, которым хотите ее решить
П.С. Насколько я понял...
Скрытый текст
Изменено: Sanja - 27.08.2026 05:56:50
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
27.08.2026 06:31:28
Sanja, вы гений, спасибо вам большое!
 
 
 
#4
27.08.2026 08:53:56
Sanja, на основе вашего примера написал вот такой макрос:
Код
Sub Macro_01()
Dim sn, iKod, iPdn, adrsPdn, iDrpd, adrsDrpd, iDorpd, adrsDorpd, iLnkToPd, adrsLnkToPd, iHCls
Dim iTbl As ListObject
Set iTbl = ActiveSheet.ListObjects("tblMaket")
sn = ActiveSheet.Name

iKod = Range("tblMaket[[#Headers],[Код]]").Column

iPdn = Range("tblMaket[[#Headers],[ПДН]]").Column
adrsPdn = Range("tblMaket[[#Headers],[ПДН]]").Address(RowAbsolute:=False, ColumnAbsolute:=False)

iDrpd = Range("tblMaket[[#Headers],[ДРПД]]").Column
adrsDrpd = Range("tblMaket[[#Headers],[ДРПД]]").Address(RowAbsolute:=False, ColumnAbsolute:=False)

iDorpd = Range("tblMaket[[#Headers],[ДОРПД]]").Column
adrsDorpd = Range("tblMaket[[#Headers],[ДОРПД]]").Address(RowAbsolute:=False, ColumnAbsolute:=False)

iLnkToPd = Range("tblMaket[[#Headers],[ссылка на ПД]]").Column
adrsLnkToPd = Range("tblMaket[[#Headers],[ссылка на ПД]]").Address(RowAbsolute:=False, ColumnAbsolute:=False)

iHCls = Range("tblMaket[[#Headers],[ПДН]:[ссылка на ПД]]").Address(RowAbsolute:=False, ColumnAbsolute:=False)

With iTbl
  With .HeaderRowRange(iPdn).Hyperlinks
    .Delete
    .Add Anchor:=iTbl.HeaderRowRange(iPdn), Address:="", SubAddress:=sn & "!" & adrsPdn, ScreenTip:=" Подтверждающий документ " & Chr(10) & " номенклатуры" & " " & ChrW(128), TextToDisplay:="ПДН"
    .Add Anchor:=iTbl.HeaderRowRange(iDrpd), Address:="", SubAddress:=sn & "!" & adrsDrpd, ScreenTip:=" Дата регистрации " & Chr(10) & " подтверждающего документа" & " " & ChrW(128), TextToDisplay:="ДРПД"
    .Add Anchor:=iTbl.HeaderRowRange(iDorpd), Address:="", SubAddress:=sn & "!" & adrsDorpd, ScreenTip:=" Дата окончания регистрации " & Chr(10) & " подтверждающего документа" & " " & ChrW(128), TextToDisplay:="ДОРПД"
    .Add Anchor:=iTbl.HeaderRowRange(iLnkToPd), Address:="", SubAddress:=sn & "!" & adrsLnkToPd, ScreenTip:=" Ссылка на подтверждающий документ" & " " & ChrW(128), TextToDisplay:="ссылка на ПД"
  End With
  .HeaderRowRange(iKod).Copy
  Range(iHCls).PasteSpecial Paste:=xlPasteFormats
End With
Application.CutCopyMode = False
iTbl.ListColumns("Код").Range.Rows(1).Select
End Sub
но он какой-то очень большой.
Помогите пожалуйста оптимизировать.
Изменено: AndreiSMT - 27.08.2026 08:55:21
 
 
 
#5
27.08.2026 09:18:03
Цитата
AndreiSMT написал: оптимизировать.
Я повторю свое сообщение
Цитата
Sanja написал: опишите саму ЗАДАЧУ, а не проблемный СПОСОБ
Что должен делать задуманный Вами макрос?
Согласие есть продукт при полном непротивлении сторон
 
 
 
#6
27.08.2026 09:29:31
Sanja, подсказки на ячейках через гиперссылку + формат этих же ячеек по образцу.
Макрос работает, но он какой-то слишком здоровенный :)
 
 
 
#7
27.08.2026 14:40:56
Допустим так
Скрытый текст

Если хотите работать в VBA с Умной таблицей, то лучше использовать ее объекты
The VBA Guide To ListObject Excel Tables
Согласие есть продукт при полном непротивлении сторон
 
 
 
#8
27.08.2026 15:01:45
Sanja, большое вам спасибо!
 
 
 
#9
27.08.2026 15:19:38
Наверное лучше так
Код
Sub AddScrenTip()
Dim iTbl As ListObject
Dim I&
Dim scrTip As String
On Error Resume Next
Application.ScreenUpdating = False
Set iTbl = ActiveSheet.ListObjects("tblMaket")
For I = 7 To 10
  Select Case I
    Case Is = 7
      scrTip = "Подтверждающий документ" & vbCrLf & "номенклатуры"
    Case Is = 8
      scrTip = "Дата регистрации" & vbCrLf & "подтверждающего документа"
    Case Is = 9
      scrTip = "Дата окончания регистрации " & vbCrLf & "подтверждающего документа"
    Case Is = 10
      scrTip = "Ссылка на подтверждающий документ"
  End Select
  With iTbl.HeaderRowRange(I)
    .Hyperlinks.Delete
    .Hyperlinks.Add Anchor:=.Item(1), Address:="", SubAddress:=.Address, ScreenTip:=scrTip
    iTbl.HeaderRowRange(1).Copy
    .PasteSpecial Paste:=xlPasteFormats
  End With
Next
iTbl.HeaderRowRange(1).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#10
28.08.2026 06:05:51
Sanja, благодарю!
 
 
 
Страницы: 1
Читают тему
Наверх