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:

Zaslat odpověď >

Ladis_01(28.8.2012 9:43)citovat#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 Sub

marjankaj(28.8.2012 10:43)citovat#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 Sub

Téma: hyperlink na jiný list

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje