Příspěvky uživatele
< návrat zpět
Som len na mobile, ale skúste zatiaľ pred .SaveAs pridať
.ActiveSheet.UsedRange.Value = .ActiveSheet.UsedRange.Value
Keď prídem pridám Vám tam ešte odchyt prípadnej chyby...
Tak raz uvádzate "vyexportovat sešit se stejným názvem" a potom zasa "zkopírovat "sheet NESHODA"". To sú dve úplne iné veci. Tu máte na Export LISTU (nie ZOŠITU !!!):
Sub ExportujList()
Dim Cesta As String, Nazev As String, CP, i As Byte
With ThisWorkbook.Worksheets("Neshoda")
Nazev = .Range("D2")
CP = Split("D:\N - Neshody\" & Nazev, "\") 'Rozlož na podadresáre
Cesta = CP(0)
If UBound(CP) > 0 Then
For i = 1 To UBound(CP) 'Cyklus vytvorí všetky požadované podadresáre, ak ešte neexistujú
Cesta = Cesta & "\" & CP(i)
If Len(Dir(Cesta, vbDirectory)) = 0 Then MkDir Cesta
Next i
End If
Nazev = Cesta & "\" & Nazev
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'Vynechá hlášku o existujúcom súbore, a prepíše ho
.Copy
With ActiveWorkbook
.ActiveSheet.Shapes("btnExportListu").Delete 'Ak sa kopíruje list so spúšťacím tlačítkom, tak sa tlačítko zmaže
.SaveAs Nazev & ".xlsx", xlOpenXMLWorkbook
.Close
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End With
End Sub
Ale to makro kde sa nachádza uvedený riadok je pre prípad ukladania každého listu (ešte raz - LISTU, nie zošitu). Ako chcete inak uložiť list, ako do súboru ? Vy keď chcete ukladať zošit (nie List), tak použite to prvé makro. To je na zošit. To druhé si ani nevšímajte.
Netreba to ukladať vždy pri prepnutí, ale iba ak došlo k nejakej zmene.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not ThisWorkbook.Saved Then ThisWorkbook.Save: MsgBox "Uložené", vbInformation
End Sub
"...list uložilo..."
??? Myslíte skutočne list ? Nie náhodou zošit ?
Ak list, tak to je niečo úplne iné.
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Dim sName As String
If Not ThisWorkbook.Saved Then
sName = ThisWorkbook.Path & "\" & Sh.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sh.Copy
With ActiveWorkbook
.SaveAs sName & ".xlsx", xlOpenXMLWorkbook
.Close
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Uložené", vbInformation
End If
End Sub
Ja to chápem takto nejak. Udržuje si to dáta v DBliste, a prepínate si roky a týždne aké chcete. Tlačítko na pridávanie ďalších súborov do DB, tlačítko na zmazanie DB, úprava rozsahu rokov a týždňov (nepočítam z možnosťou že týždne chýbajú, dovolí chýbajúce navoliť, no nič nezobrazí), .... Zmenil som Vám všetky formáty, lebo ak chcete zobraziť % s medzerou pred znakom %, musí sa tam dať pevná medzera (Alt+0160), všade vzorce ťahajúce dáta z DB podľa navoleného roku a týždňa.
ALE !!!
Netuším ako urobiť, aby sa nebili voľby rok+týždeň (sú na seba viazané), ale kontru im robí voľba mesiaca. To predsa koliduje, keď si môžete navoliť 45 týždeň roku a zároveň február.
No úplne na koniec som si dofrasa všimol, že tam máte nejaký skrytý C:C, v ktorom sú odkazy na súbory, a s tým už fakt netuším čo.
Pekný deň. Možno niečo použijete.
PS: Ešte som premýšľal urobiť Načítanie súboru ako parametrizovanú procedúru, a dalo by sa potom načítať aj viac súborov naraz. Na viac nemám teraz čas, a neviem či to vôbec môže takto byť :)
EDIT:
Ešte som zabudol zmeniť formát % v priemeroch - B26,B56,B86,B116,B146,B176. Treba tam dať
0,0 %
Tá medzera je "Pevná medzera". Teda nie medzerník, ale ľavý Alt+0160. Tak ako som to použil aj na iných percentách...
Podľa mňa stačí na to napáskovať previazané zoznamy, a aj jednoduchý človek vie, že keď to naňho kričí na červeno, je to zle :)
No a kdeže je ?
Ale týmto už končím. Uznajte sama...
Celé prekopané, keď bude niekedy čas, tak Vám možno to makro aj popíšem.
Nejde mi to stiahnuť. Píše "stránka nenalezena". Pošlite mi to mailom, alebo to dajte na GoogleDrive, či niekam inam. Uvidím, kedy na to vyjde čas, možno zajtra ...
Pr. Niektoré to ale neošetrí. Napr. "/". Považuje to potom za dátum.
EDIT:
Neviem čo vymýšľam, proste tam dajte iba overenie dát
Povoliť : Čas
Údaje: je medzi
Začiatok: 0:00:00
Čas ukončenia:
23:59:00
Teda makro má pri vykonávaní pridať 2 stĺpce ? Tie tam pred vykonaním nie sú ?
Premenná Text je zmazaná, teda sa nebude vkladať do prázdnych buniek v O:O ten text "Začiatok hod." & Chr(10) & "Koniec hod." ? A teda sa nebude ani tento text vyhľadávať a farba COLOR_KONIEC je zbytočná ?
Čo sa má do tých 2 stĺpcov dávať ?
Zachovať formátovanie ako je ? Prvý a posledný riadok nových stĺpcov dátovej časti má iné vystredenie a nemá tučné písmo, ako ostatok tabuľky. Takže asi nebude platiť "zachovať formátovanie ako je" ?
Urobil som pár úprav a vyremoval zatiaľ nejaké časti. Upresnite. A priložte lepší príklad.
Ja som si pri čítaní dotazu na Vás hneď spomenul. Snáď budem raz donútený sa to PQ lepšie priučiť :)
Palec hore.
Lenže Vy máte problém s tým, že ten Váš čas nieje taký ako vyzerá (na X-tom desatinnom mieste). Tu som Vám pripravil nejaké úryvky kódu. Niečo si z toho vyzobte. Na čas treba dávať vždy pozor, nielen vo VBA ale aj v Exceli, lebo sú to dlhé desatinné čísla, ktoré vznikajú delením s neustálym zvyškom. Niekde sa to zaokrúhliť nakoniec musí.
Jednotka času je číslo 1 - jeden deň teda 24 hodín
hodinu získame 1/24=0,0416666666666667
a to zase na minúty 1/24/60=0,000694444444444444
a sekundy 1/24/60/60=0,0000115740740740741
No uznajte, že občas sa to zaokrúhľovanie nemusí trafiť. Rovnako ako napr. zaokrúhľovanie halierov/centov pri mikrocenách za ks, spätne sa často nedopočítate k rovnakému číslu, preto máme halierové vyrovnania.
Časovú radu si vytvorte napr. natiahnutím vzorca:
=TIME(0;30*(ROW(A1)-1);0)
=ČAS(0;30*(ŘÁDEK(A1)-1);0)
To také jednoduché nebude. Nevieme čo znamená "od každého programu". A treba kopírovať iba 50 hodnôt.
Osobne ďalej čakám na prílohu...
Uživatelské menu
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
RSS nejnovější články