• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: VBA - Automatické přidání a pojmenování listů

Zaslal/a Anicka 4.8.2017 14:16

Dobrý den,
mohla bych poprosit o radu?
Mám v jednom listu (C7:A350) hodnoty (jsou tam i prázdné buňky) a chtěla bych ke každé této hodnotě vytvořit nový list s odpovídajícím názvem. Tedy hodnota v buňce=název listu + po kliknutí na určitou buňku by se zobrazil odpovídající list.
Existuje na to nějaký postup?
Děkuji.
MO Professional Plus 2010

Příloha: 37118_sesit1.zip (32kB, staženo 49x)

Zaslat odpověď >

---

Strana:  « předchozí  1 2 3

Stalker(8.10.2017 1:39)#037847

Třeba takto:
Sub VytvorList()

Dim JmenoListu As String

Application.ScreenUpdating = False
Sheets.Add After:=Worksheets(Sheets.Count):
Range("B2").Value = "Aktualizováno:"
Range("B3").Value = WorksheetFunction.Text(Sheets("Zadávací_list").Range("F7").Value, "d.m.yyyy h.mm.ss")
JmenoListu = Range("B3").Value
On Error Resume Next
ActiveSheet.Name = JmenoListu
If Err.Number = 1004 Then

Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
MsgBox "Nelze provést! => List s požadovanými daty již existuje!" & vbNewLine & "Proveďte novou aktualizaci dat tlačítkem Načti data na záložce Zadávací_list.", vbCritical, "!!! VAROVÁNÍ !!!"
Sheets("Zadávací_list").Select
Exit Sub
End If
On Error GoTo 0

Range("A11").Select
ActiveWindow.FreezePanes = True
Application.ScreenUpdating = True
End Sub


Jelikož se mi už chce spát, moc sem na tom nepřemýšlel. Určitě to půjde udělat i jinak.

Edit: Koukám, že elninoslov taky nemohl zabrat. Není nad to udělat refresh stránky Dobrou.citovat

native12(8.10.2017 9:36)#037850

Moc Vám děkuji, funguje to.

Nechci zakládat nové téma, tak ještě jeden dotaz napíšu sem.
Ještě bych potřeboval poradit s pozastavením makra, když v cyklu "Nacti" načítá data ze serveru a trvá to různě dlouho. Potřebuji, aby makro nešlo do dalšího cyklu "VytvorList":


Sub Aktualizace()
Application.ScreenUpdating = False
Call Vymaz_Data_Material
Call Vymaz_Data_Operace
'===========================================================
Call Nacti

'===========================================================
Call VytvorList
Call Kopiruj_Data_Material
Call Kopiruj_Data_Operace
Sheets(tento).Select
Application.ScreenUpdating = True
End Sub


Makro "Nacti" je o aktualizaci dat na dvou listech: "Data_Materiál" a "Data_Operace" přes dva dotazy: "Dotaz z s-st-sl8db_Live_app" a "Dotaz z s-st-sl8db_Live_app1"


Sub Nacti()
ActiveWorkbook.RefreshAll
End Sub


Díky za vaši radu.citovat

elninoslov(8.10.2017 21:21)#037854

Skúste refresh-núť oba dotazy samostatne a po každom použite toto:
Do
Loop While MenoListu.QueryTables("NazovDotazu").Refreshing
či to nepomôže.citovat

native12(9.10.2017 6:21)#037856

Zkoušel jsem to dvěma způsoby - viz kód níže.


Sub Nacti()
'Sheets("Data_Materiál").Select
'ActiveWorkbook.Connections("Dotaz z s-st-sl8db_Live_app").Refresh
Do
Sheets("Data_Materiál").Select
ActiveWorkbook.Connections("Dotaz z s-st-sl8db_Live_app").Refresh
Loop While Data_Materiál.QueryTables("Dotaz z s-st-sl8db_Live_app").Refreshing
'Sheets("Data_Operace").Select
'ActiveWorkbook.Connections("Dotaz z s-st-sl8db_Live_app1").Refresh
Do
Sheets("Data_Operace").Select
ActiveWorkbook.Connections("Dotaz z s-st-sl8db_Live_app1").Refresh
Loop While Data_Operace.QueryTables("Dotaz z s-st-sl8db_Live_app1").Refreshing
End Sub


Pokaždé to u řádku: Loop While ......
skončilo s chybou: Run-time error '424': Object required

Napadá vás řešení?
Díky moc za ochotu.citovat

elninoslov(9.10.2017 14:00)#037860

V staršej verzii to bude QueryTables v novšej Connection.
Čistý tip, z brucha 2 verzie. Neskúšal som:
Sub Nacti()
With ThisWorkbook.Connections("Dotaz z s-st-sl8db_Live_app")
.Refresh
Do
Loop While .Refreshing
End With

With ThisWorkbook.Connections("Dotaz z s-st-sl8db_Live_app1")
.Refresh
Do
Loop While .Refreshing
End With
End Sub

Sub Nacti2()
Dim i As Integer
ThisWorkbook.Connections("Dotaz z s-st-sl8db_Live_app").Refresh
Do Until i = False
i = ThisWorkbook.Connections("Dotaz z s-st-sl8db_Live_app").Refreshing
Loop
i = 0
ThisWorkbook.Connections("Dotaz z s-st-sl8db_Live_app1").Refresh
Do Until i = False
i = ThisWorkbook.Connections("Dotaz z s-st-sl8db_Live_app1").Refreshing
Loop
End Sub

EDIT:
A ešte ma napadá či máte skutočne správne názov dotazu, a či Data_Operace je CodeName alebo nápis na ušku listu. Je rozdiel
Data_Operace.xyz
Worksheets("Data_Operace").xyzcitovat

native12(9.10.2017 14:20)#037862

Poradil R. Jureček.
Vypadá, že to je OK.


Sub Nacti()
ActiveWorkbook.RefreshAll
Application.CalculateUntilAsyncQueriesDone
End Sub
citovat

Strana:  « předchozí  1 2 3

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse