Mno, on El Niño, když něco dělá večer, tak už se tak nesoustředí ;))
Snad se na mně nebude zlobit, když to trochu popoženu ;)
Má tam jednu nepřesnost v řádku
Set Klik = Intersect(Columns(2), Target.Cells(1, 1))A další důvod proč to nejede a proč do toho vstupuji není jeho chybou, ale je to opět ta lokalizace.
Shapes("TextBox 1") mám já v českém excelu 2007 jako Shapes("BlokTextu1")
Abyste otestovala, tak to zatím sjednotíme na 1. Zkuste a dejte vědět, jestli je to to, co jste chtěla.
Nahraďte si jeho kód tímto:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Klik As Range, TX As String, Stlpcov As Integer, dStlpec As Integer, dRiadkov As Integer
Set Klik = Intersect(Columns(2), Target.Cells(1).EntireRow)
If Not Klik Is Nothing Then
If Klik.Value = "" Or Klik.Row < 2 Then
Shapes(1).Visible = False
Else
With Worksheets("Data")
Stlpcov = .Cells(1, Columns.Count).End(xlToLeft).Column
If Stlpcov = 1 And .Cells(1, 1) = "" Then Shapes("TextBox 1").Visible = False: Exit Sub
On Error Resume Next
dStlpec = WorksheetFunction.Match(Klik, .Cells(1, 1).Resize(, Stlpcov), 0)
dRiadkov = .Cells(.Rows.Count, dStlpec).End(xlUp).Row
If Err = 0 Then TX = Join(Application.Transpose(.Cells(2, dStlpec).Resize(IIf(dRiadkov > 2, dRiadkov - 1, 1)).Value), vbNewLine)
On Error GoTo 0
With Shapes(1)
.Visible = True
.TextFrame.Characters.Text = TX
.Left = Klik.Offset(, 1).Left
.Top = Klik.Offset(, 1).Top
End With
End With
End If
Else
Shapes(1).Visible = False
End If
End Sub
@elninoslov
Pokud je to ono, můžete zkusit místo textového pole využít Ověření dat - Zobrazit zprávu při zadávání. Nemusíte pak řešit pozici zprávy. I když nevím, jak to OP myslela s těmi odkazy
"spíš formou odkazu."citovat