< návrat zpět
MS Excel
Téma: hyperlink na jiný list
Zaslal/a Ladis_01 28.8.2012 9:35
Zdravím,
řeším situaci, kdy mám v sešitu dva listy, obsahují defakto stejná data, přičemž list "objednávky s materiálem" obsahují podrobnějšíionfo o objednávce.
Záměr je ke stejným řádkům makrem vložit odkaz na příslušný řádek na druhém listu, aby se dalo rychleji a efektivněji data identifikova. Makro jede, ale Excel "bliká" přepínáním mezi listy. Nepřišel jsem nato, jak když jsem v jednom listu jak do druhého vložit tento hypeertextový odkaz. Bez aktivace mi to prostě neklapne, nebo je nějaká metoda jak Axcel přinutit nepřekreslovat obrazovku? Díky.
ukázka kodu:
Ladis_01(28.8.2012 9:43)#009333 Sub hyperlink()
a = 61
r = 4
Worksheets("objednávky").Activate
Do While Worksheets("objednávky").Cells(r, 2) <> ""
Do While Worksheets("objednávky s materiálem").Cells(a, 10) <> ""
If Worksheets("objednávky").Cells(r, 2) = Worksheets("objednávky s materiálem").Cells(a, 1) Then
Worksheets("objednávky").Hyperlinks.Add Anchor:=Cells(r, 22), Address:="", SubAddress:= _
"'objednávky s materiálem'!B" & a, TextToDisplay:=Worksheets("objednávky").Cells(r, 2).Text
' tady to muséme přepnout na druhý list, aby se vložil odkaz, jináč mi to zatím nejde :)
Worksheets("objednávky s materiálem").Select
Worksheets("objednávky s materiálem").Hyperlinks.Add Anchor:=Cells(a, 2), Address:="", SubAddress:="'objednávky'!V" & r, TextToDisplay:=Worksheets("objednávky").Cells(r, 2).Text
Worksheets("objednávky").Select
' a zase zpět na původní list
Exit Do
End If
a = a + 1
Loop
a = 61
r = r + 1
Loop
End Subcitovat
marjankaj(28.8.2012 10:43)#009334 Sub hyperlink()
Application.ScreenUpdating = False
'kód
Application.ScreenUpdating = true
End Sub
Alebo skús toto
Sub hyperlink()
a = 61
r = 4
Set ws1 = Worksheets("objednávky")
Set ws2 = Worksheets("objednávky s materiálem")
' tady to muséme přepnout na druhý list, aby se vložil odkaz, jináč mi to zatím nejde :)
ws2.Activate
Do While ws1.Cells(r, 2) <> ""
Do While ws2.Cells(a, 10) <> ""
If ws1.Cells(r, 2) = ws2.Cells(a, 1) Then
ws1.Hyperlinks.Add Anchor:=Cells(r, 22), Address:="", SubAddress:= _
"'objednávky s materiálem'!B" & a, TextToDisplay:=ws1.Cells(r, 2).Text
ws2.Hyperlinks.Add Anchor:=Cells(a, 2), Address:="", SubAddress:="'objednávky'!V" & r, TextToDisplay:=ws1.Cells(r, 2).Text
Exit Do
End If
a = a + 1
Loop
a = 61
r = r + 1
Loop
' a zase zpět na původní list
ws1.Activate
End Subcitovat