< návrat zpět

MS Excel


Téma: VBA vytvoření sešitu a přepnutí se zpět rss

Zaslal/a 7.5.2016 20:45

ahoj, poradil by mi někdo jak udělat nový sešit makrem, to je celkem snadné, ale nevím jak se po založení nového sešitu vrátit zpět do sešitu, ze kterého se makro spouštělo.. poradí někdo?

Zaslat odpověď >

Strana:  « předchozí  1 2 3   další »
#031447
avatar
děkuji za upřesnění, select používat tedy nebudu :).. takovéto vysvětlení mi bohatě stačí..
xlnc: při kopírovování skrytého listu makro končí chybou, proto jej potřebuji zviditelnit, jinak bych tento krok velice rád vynechal :)citovat
#031449
avatar
Jakou chybou? Konkrétní sešit, ...citovat
#031450
avatar
stačí použít makro1, které přikládal "elninoslov", můžete vyzkoušet, pokud je list skrytý, makro končí chyboucitovat
#031451
elninoslov
Ak sa použije toto:
Sheets(Array("List1", "List2", "List3")).Select
ActiveWindow.SelectedSheets.Visible = False

tak ich schováte naraz, ale naopak to urobiť neviem či pôjde.
Podľa toho či použijete kombináciu s ActiveWindow alebo ThisWorkbook dostanete chybu 1004 (Nie je možné nastaviť vlastnosť Visible triedy Sheets) alebo 438 (Object doesn´t support this property or method).

A naopak ak sa pokúsime použiť na schované listy
Worksheets(Array("List1", "List2", "List3")).Copy
Dostaneme 1004 (Metóda Copy triedy Sheets zlyhala).

Nechce sa mi to ďalej skúmať. Ak použijete ScreenUpdating = False máte to za okamžik aj po jednom.citovat
#031453
avatar
Věc první:
Metoda Copy na listu funguje, ale... Pokud je cílem stejný sešit, pak se vytvoří skrytá kopie. Nelze použít čistě Copy bez uvedení cíle pro vytvoření nového sešitu s tímto listem. Je potřeba nejprve zavést nový sešit a do něj pak aplikovat Copy (list v cíli bude vidět). Následovat tedy musí vyřazení nepotřebných listů.

Set wkbNovySesit = Workbooks.Add
Worksheets("List2").Copy After:=wkbNovySesit.Worksheets(1)citovat
#031454
avatar
Kruciš, už blbnu. Zkopírovaný list bude vždycky skrytý samozřejmě.

Malý neoptimalizovaný nástřel před obědem:

Sub KopieSkrytehoListu()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wkbTentoSesit = ThisWorkbook
Set wkbNovySesit = Workbooks.Add

With wkbNovySesit

wkbTentoSesit.Worksheets("Skrytý list").Copy Before:=.Worksheets(1)

.Worksheets("Skrytý list").Visible = True

intPocetListu = wkbNovySesit.Worksheets.Count

For i = intPocetListu To 2 Step -1
.Worksheets(i).Delete
Next i

End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Subcitovat
#031458
elninoslov
xlnc: To je super, o tom som netušil, aspoň polovička je ušetrená. Škoda že nejdú hromadne odkryť.

Ešte poznámku: Stretol som sa dávnejšie s problémom, ktorý nastal pri takomto kopírovaní, ak bola na liste Tabuľka (ListObject), a pomohlo len dočasné vypnutie .Calculation, preto som to v makre naznačil.

Sub Vytvor_Novy2()
Dim Cesta As String, LST, Pocet As Integer, i As Integer

LST = Array("List1", "List2", "List3") 'Pole listov
Cesta = ThisWorkbook.Path & "\"

With Application
.ScreenUpdating = False: .DisplayAlerts = False ': .Calculation=xlCalculationManual

With Workbooks.Add 'Nový súbor
Pocet = .Worksheets.Count 'Počet vytváraných listov
ThisWorkbook.Worksheets(LST).Copy After:=.Worksheets(Pocet) 'Skopíruj listy

For i = 0 To UBound(LST) 'Zviditeľni listy
.Worksheets(LST(i)).Visible = True
Next i
For i = 1 To Pocet 'Vymaž defaultné listy
.Worksheets(1).Delete
Next i

' iné práce na novom súbore

.SaveAs Cesta & "Nový súbor.xlsx" 'Ulož a zatvor
.Close
End With

.ScreenUpdating = True: .DisplayAlerts = True ': .Calculation = xlCalculationAutomatic
End With
End Sub
citovat
#031459
avatar
A proč je chcete odkrývat?

Sub KopieSkrytehoListu()

Dim wkbTentoSesit As Workbook
Dim wkbNovySesit As Workbook

Dim arrPole

Dim intPocetListu As Integer
Dim strRetezec As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wkbTentoSesit = ThisWorkbook
Set wkbNovySesit = Workbooks.Add

With wkbNovySesit

wkbTentoSesit.Worksheets("Skrytý list").Copy Before:=.Worksheets(1)

.Worksheets("Skrytý list").Visible = True

intPocetListu = wkbNovySesit.Worksheets.Count
strRetezec = "TRANSPOSE(ROW(2:" & intPocetListu & "))"

arrPole = Evaluate(strRetezec)

.Worksheets(arrPole).Delete

End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub
citovat
#031460
avatar
Asi takhle to vidím:

Sub KopieSkrytehoListu()

Dim wkbTentoSesit As Workbook
Dim wkbNovySesit As Workbook

Dim arrPole

Dim intPocetListu As Integer
Dim strRetezec As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wkbTentoSesit = ThisWorkbook
Set wkbNovySesit = Workbooks.Add

With wkbNovySesit

wkbTentoSesit.Sheets(Array("Skrytý list 1", "Skrytý list 2")).Copy Before:=.Worksheets(1)

.Worksheets("Skrytý list 1").Visible = True
.Worksheets("Skrytý list 2").Visible = True

intPocetListu = .Worksheets.Count
strRetezec = "TRANSPOSE(ROW(3:" & intPocetListu & "))"

arrPole = Evaluate(strRetezec)

.Worksheets(arrPole).Delete

End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub
citovat
#031462
elninoslov
xlnc: Odkrývať ich v novom WB chceme/musíme, inak by to nešlo :)
Zaujímavý spôsob vytvorenia čiselného poľa pri Delete. Dobrá inšpirácia.citovat

Strana:  « předchozí  1 2 3   další »

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje