Dobry den, predem se omlouvam pokud uvadim tema/pozadavek spatne, popr. pokud zde jiz neco takoveho je. Potreboval bych od nekoho zkuseneho poradit ohledne tvorby makra.
A) Mam na prvnim listu (List1=Prehled) seznam s hodnotami A-X. Z tohoto seznamu bych chtel vytvorit pro kazdou hodnotu list s nazvem z odpovidajici bunky seznamu. Tedy razeni listu v sesite by bylo "Prehled" a nasledne listy A-X. Neco podobneho jsem nasel, ale neni to zcela dle mych predstav. (V pripade shodnych hodnot by tato byla preskocena).
B) Na kazdem nove vytvorenem listu by bylo tlacitko/bunka s hypertext. odkazem ktera by vracela vzdy na prvni list, tedy na "Prehled".
Muze mi prosim nekdo poradit jak na to?
Mnohokrat dekuji.
Excel - makro na upravu listu
Re: Excel - makro na upravu listu
Ahoj, tu je časť kodu (treba dokončiť Hyperlinks s odkazem na list Prehled)
rozdelil som to na 3 samostatné makra:
Sub AddSheets()
' tvorba listu se seznamu
Dim cell As Excel.Range
Dim wsWithSheetNames As Excel.Worksheet
Dim wbToAddSheetsTo As Excel.Workbook
Set wsWithSheetNames = ActiveSheet
Set wbToAddSheetsTo = ActiveWorkbook
'For Each cell In wsWithSheetNames.Range("A2:A5") rozsah bunek alebo select, ako je o riadok nižšie
For Each cell In Intersect(Selection, ActiveSheet.UsedRange)
With wbToAddSheetsTo
.Sheets.Add After:=.Sheets(.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = cell.Value
On Error GoTo 0
End With
Next cell
Call LIST
End Sub
Sub LIST()
' pro seznam listu
Sheets("Prehled").Select
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "list"
Dim mySheet As Worksheet, myRow As Long
With Sheets("list")
' .Range("A:A").Clear
myRow = 1
For Each mySheet In ActiveWorkbook.Worksheets
If mySheet.Name <> "Menu" Then
.Hyperlinks.Add Anchor:=.Cells(myRow, 1), Address:="", SubAddress:= _
"'" & mySheet.Name & "'!A1", TextToDisplay:=mySheet.Name
myRow = myRow + 1
End If
Next mySheet
End With
Call Hyperlinks
End Sub
Sub Hyperlinks()
' treba ešte dokončiť Hyperlinks na list "Prehled" !!
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
With ws
' treba dokončiť Hyperlinks na list Prehled
End With
Next ws
End Sub
Pepo
rozdelil som to na 3 samostatné makra:
Sub AddSheets()
' tvorba listu se seznamu
Dim cell As Excel.Range
Dim wsWithSheetNames As Excel.Worksheet
Dim wbToAddSheetsTo As Excel.Workbook
Set wsWithSheetNames = ActiveSheet
Set wbToAddSheetsTo = ActiveWorkbook
'For Each cell In wsWithSheetNames.Range("A2:A5") rozsah bunek alebo select, ako je o riadok nižšie
For Each cell In Intersect(Selection, ActiveSheet.UsedRange)
With wbToAddSheetsTo
.Sheets.Add After:=.Sheets(.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = cell.Value
On Error GoTo 0
End With
Next cell
Call LIST
End Sub
Sub LIST()
' pro seznam listu
Sheets("Prehled").Select
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "list"
Dim mySheet As Worksheet, myRow As Long
With Sheets("list")
' .Range("A:A").Clear
myRow = 1
For Each mySheet In ActiveWorkbook.Worksheets
If mySheet.Name <> "Menu" Then
.Hyperlinks.Add Anchor:=.Cells(myRow, 1), Address:="", SubAddress:= _
"'" & mySheet.Name & "'!A1", TextToDisplay:=mySheet.Name
myRow = myRow + 1
End If
Next mySheet
End With
Call Hyperlinks
End Sub
Sub Hyperlinks()
' treba ešte dokončiť Hyperlinks na list "Prehled" !!
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
With ws
' treba dokončiť Hyperlinks na list Prehled
End With
Next ws
End Sub
Pepo
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
-
EXCEL -jak otevřít 2 excel sobory abych je viděla současne a samostatně
od Ketty02 » 30 srp 2024 21:19 » v Vše ostatní (sw) - 2
- 4888
-
od Riviera kid
Zobrazit poslední příspěvek
02 zář 2024 16:21
-
-
- 4
- 4445
-
od junis
Zobrazit poslední příspěvek
22 črc 2024 17:54
-
- 2
- 12298
-
od Snekment
Zobrazit poslední příspěvek
29 led 2025 15:05
-
- 1
- 4995
-
od atari
Zobrazit poslední příspěvek
07 kvě 2025 09:41
-
- 3
- 3399
-
od lubo.
Zobrazit poslední příspěvek
24 říj 2024 00:00
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 3 hosti