VBA - aktualizace schovaných a zamčených listů Vyřešeno

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Toomicek
nováček
Příspěvky: 49
Registrován: listopad 12
Pohlaví: Nespecifikováno
Stav:
Offline

VBA - aktualizace schovaných a zamčených listů  Vyřešeno

Příspěvekod Toomicek » 15 srp 2014 15:36

Ahoj,

potřebuji pomoci s timto makrem. Chci aby se odheslovaly listy a celý sešit následně se udělaly viditelnými a refreshnuly se a pak zase schovalya následně se všechno zase zamklo při spuštění listu. Všeude mám kontingenční tabulky. Pěkně se mi to otevře rozbalí se listy a zavřou, ale refreshne se to až na konci procesu :(

jsem brutální amatér ve VBA, takže určitě dělám nějakou triviální chybu v posloupnostech procesů. Ty application.wait jsem zkoušel aby dali čas refreshi, ale nepomohlo to :)

Díky za pomoc

Kód: Vybrat vše

Private Sub Workbook_Open()
ThisWorkbook.Unprotect Password:="1111"
ActiveSheet.Unprotect Password:="1111"
    Dim ws As Worksheet
    For Each ws In Worksheets
    ws.Visible = True
    Next
Application.Wait Now + TimeValue("00:00:03")
ActiveWorkbook.RefreshAll
Application.Wait Now + TimeValue("00:00:03")
    For Each ws In Worksheets
    If ws.Name <> ActiveSheet.Name Then ws.Visible = False
    Next
   
ActiveSheet.Protect Password:="1111"
ThisWorkbook.Protect Password:="1111"
    Application.Wait Now + TimeValue("00:00:02")
    MsgBox "Aktualizace hotova"
End Sub

Reklama
cmuch
Level 4.5
Level 4.5
Příspěvky: 1544
Registrován: březen 11
Bydliště: Drsná Vysočina :D
Pohlaví: Muž
Stav:
Offline

Re: VBA - aktualizace schovaných a zamčených listů

Příspěvekod cmuch » 15 srp 2014 18:18

Mohlo by stačit

Kód: Vybrat vše

Private Sub Workbook_Open()
  Dim ws As Worksheet
  With ThisWorkbook
    .Unprotect Password:="1111"
    For Each ws In Worksheets
      ws.Unprotect Password:="1111"
    Next
   .RefreshAll
   For Each ws In Worksheets
     ws.Protect Password:="1111"
   Next
   .Protect Password:="1111"
  End With
  MsgBox "Aktualizace hotova"
End Sub

Toomicek
nováček
Příspěvky: 49
Registrován: listopad 12
Pohlaví: Nespecifikováno
Stav:
Offline

Re: VBA - aktualizace schovaných a zamčených listů

Příspěvekod Toomicek » 18 srp 2014 07:14

Díky za odpověď, ale má to pár much :)

Potřebuji ještě aby mi to po odemčení listů a sešitu zobrazilo veškeré skryté listy a tyhle listy to aktualizovalo, pak všechny schovalo kromě titulní strany. Následně zamklo SEŠIT (aby nešli zobrazit uživateli skryté listy) a jako další zamklo JEN aktivní list (titulní stranu). Mám totiž v sešitě list "kontrola" kam se mi zapisuje kdo soubor uložil a to když jsou zamčené všechny listy nefunguje.

Taky mi přišlo, že dle tvého makra se mi rozjela aktualizace, ale moc rychle se zamkli sešity, než to stihlo zaktualizovat všechno, tudíž pak vyskočila chyba, že nejde změnit zamčené listy.

Díky za pomoc :)

--- Doplnění předchozího příspěvku (18 Srp 2014 07:47) ---

Pokud vložím tohle do jednoduššího listu s kontingenčními tabulkami bez SQL příkazů (Čerpání dat do zdrojů dat pro kont.tabulky přes SQL příkazy), tak to stihne všechno úplně v pohodě :(

Kód: Vybrat vše

Private Sub Workbook_Open()

'zakázání viditelných změn
Application.ScreenUpdating = False
'zde se odhesluje sešit
ActiveWorkbook.Unprotect Password:="1111"
'zde se odhesluje activesheet
ActiveSheet.Unprotect Password:="1111"
'zobrazení hidden sheets
Dim ws As Worksheet
For Each ws In Worksheets
ws.Visible = True
Next
'refresh
ActiveWorkbook.RefreshAll
'Schování všech listů kromě activesheet
For Each ws In Worksheets
If ws.Name <> ActiveSheet.Name Then ws.Visible = False
Next
'zaheslování activesheet
ActiveSheet.Protect Password:="1111"
'zaheslování sešitu
ActiveWorkbook.Protect Password:="1111"
'povolení viditelných změn
Application.ScreenUpdating = True
'zpráva pro uživatele
MsgBox "Aktualizace hotova"

End Sub


Fakt nevim :(

--- Doplnění předchozího příspěvku (18 Srp 2014 09:15) ---

Tak jsem trochu listoval a našel odpovědi, ale teď mám trochu jinej problém.

Když dám aktualizovat data, tak se mi pěkně aktualizujou kont.tabulky, ale data z SQL se mi stáhnou, až na konci (po aktualizaci kont. tabulek), což bych chtěl obráceně.

Kód mám následující - DoEvents nepomohlo a ani Query refresh :(

Kód: Vybrat vše

Private Sub Aktualizace()

'zakázání viditelných změn
Application.ScreenUpdating = False

'zde se odhesluje sešit
ActiveWorkbook.Unprotect Password:="1111"

'zde se odhesluje activesheet
ActiveSheet.Unprotect Password:="1111"

'zobrazení hidden sheets
Dim ws As Worksheet
For Each ws In Worksheets
ws.Visible = True
Next

'refresh all
ActiveWorkbook.Refreshall
DoEvents

'refresh Queries
    Dim q As QueryTable
    On Error Resume Next
    For Each ws In ActiveWorkbook.Worksheets
        Application.StatusBar = "Aktualizuji data v: " & ws.Name
        For Each q In ws.QueryTables
            q.Refresh
        Next
    Next
   
'refresh pivot tables
Dim p As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
    On Error Resume Next
    For Each ws In ActiveWorkbook.Worksheets
        Application.StatusBar = "Aktualizuji kontingenční tabulku: " & ws.Name
        For Each p In ws.PivotTables
            For Each pf In p.PivotFields
                For Each pi In pf.PivotItems
                    pi.Delete
                Next
            Next
            p.RefreshTable
            p.Update
        Next
    Next

   
'Schování všech listů kromě activesheet
For Each ws In Worksheets
If ws.Name <> ActiveSheet.Name Then ws.Visible = False
Next

'zaheslování activesheet
ActiveSheet.Protect Password:="1111"

'zaheslování sešitu
ActiveWorkbook.Protect Password:="1111", Structure:=True, Windows:=False

'povolení viditelných změn
Application.ScreenUpdating = True

'Vrácení status baru do Excelovské režie
Application.StatusBar = False

'zpráva pro uživatele
MsgBox "Aktualizace hotova"

End Sub


--- Doplnění předchozího příspěvku (18 Srp 2014 09:54) ---

SOLVED :)

Kód: Vybrat vše

'Refresh tabulek
'Je nutné mít v připojeních NEzaškrtnuté aktualizace na pozadí (Excel potom nečeká na aktualizace)
ActiveWorkbook.Connections("Karta zakázky").Refresh
ActiveWorkbook.Connections("Obraty").Refresh
ActiveWorkbook.Connections("Sestava 555").Refresh
ActiveWorkbook.Connections("Smluvni cena").Refresh


Tohle mi aktualizuje databáze, tudíž vloženo před kód s kont.tabulkama

Kód: Vybrat vše

Private Sub Workbook_Open()
'Timer
Application.Wait Now + TimeValue("0:00:03")

'zakázání viditelných změn
Application.ScreenUpdating = False

'zde se odhesluje sešit
ActiveWorkbook.Unprotect Password:="1111"

'zde se odhesluje activesheet
ActiveSheet.Unprotect Password:="1111"

'zobrazení hidden sheets
Dim ws As Worksheet
For Each ws In Worksheets
ws.Visible = True
Next

'Refresh tabulek
ActiveWorkbook.Connections("Karta zakázky").Refresh
ActiveWorkbook.Connections("Obraty").Refresh
ActiveWorkbook.Connections("Sestava 555").Refresh
ActiveWorkbook.Connections("Smluvni cena").Refresh

'refresh Queries
    Dim q As QueryTable
    On Error Resume Next
    For Each ws In ActiveWorkbook.Worksheets
        Application.StatusBar = "Aktualizuji data v: " & ws.Name
        For Each q In ws.QueryTables
            q.Refresh
        Next
    Next
   
'refresh pivot tables
Dim p As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
    On Error Resume Next
    For Each ws In ActiveWorkbook.Worksheets
        Application.StatusBar = "Aktualizuji kontingenční tabulku: " & ws.Name
        For Each p In ws.PivotTables
            For Each pf In p.PivotFields
                For Each pi In pf.PivotItems
                    pi.Delete
                Next
            Next
            p.RefreshTable
            p.Update
        Next
    Next

   
'Schování všech listů kromě activesheet
For Each ws In Worksheets
If ws.Name <> ActiveSheet.Name Then ws.Visible = False
Next

'zaheslování activesheet
ActiveSheet.Protect Password:="1111"

'zaheslování sešitu
ActiveWorkbook.Protect Password:="1111", Structure:=True, Windows:=False

'povolení viditelných změn
Application.ScreenUpdating = True

'Vrácení status baru do Excelovské režie
Application.StatusBar = False

'zpráva pro uživatele
MsgBox "Aktualizace hotova"

End Sub



  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Excel - automatický export listů xls do pdf včetně pojmenování Příloha(y)
    od kalosek » 28 čer 2023 20:31 » v Kancelářské balíky
    2
    1826
    od kalosek Zobrazit poslední příspěvek
    29 čer 2023 19:39
  • Instalace aktualizace pro Windows 10 Příloha(y)
    od hanni2000 » 17 srp 2023 13:24 » v Windows 11, 10, 8...
    2
    1100
    od sim20 Zobrazit poslední příspěvek
    17 srp 2023 14:46
  • Windows 10 - Chyba aktualizace 0x80070643
    od nations112 » 12 led 2024 18:58 » v Windows 11, 10, 8...
    11
    3629
    od petr22 Zobrazit poslední příspěvek
    12 bře 2024 21:46
  • Hry neběží plynule - aktualizace ovladačů Příloha(y)
    od Forhill » 30 pro 2023 12:41 » v Problémy s hardwarem
    3
    630
    od petr22 Zobrazit poslední příspěvek
    30 pro 2023 16:15
  • Aktualizace ktera znemozni prihlaseni Win XP do domeny
    od petr22 » 09 kvě 2023 13:10 » v Administrace sítě
    1
    1554
    od pcmaker Zobrazit poslední příspěvek
    09 kvě 2023 17:19

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Seznam[Bot] a 8 hostů