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

Příspěvky uživatele

Moc nevím, zda Vám rozumím. Co si mám představit pod pojmem změnit funkci ? ... předpokládám, že si user může vymyslet vlastní funkci.

Pokud chcete vytvořit makro do kterého vložíte textovou funkci a dostanete výsledek, pak to bude muset mít o něco více řádku. V javě je nějaká funkce, která po vložení textového příkladu jej vypočte. To znamená přeložit text, pochopit, sestavit postup a provést výpočet. Říká se tomu interpret a něco takového by bylo potřeba.

V javě a php jsou napsané hezké stránky
http://wood.mendelu.cz/math/maw-html/index.php?lang=cs&form=integral
na kterých se dá sestavit integrál a vypočíst nebo upravit ... atd. Zkuste si na stránce spustit aplet java "MAW Maxima Popup" a vytvořit vzorec, který se vrátí z okna do řádku zadání. Předpokládám, že to stejné bude mít Váš user a makro funkci rozparsuje, poskládá podle matematických priorit a vypočte výsledek který bude vrácen. Jen pro upřesnění - ty webovky se dělají několik let.

Asi by se mi nechtělo to stejné vyrábět znovu.
R.

Pokud chceš laborovat s rychlostí, hodilo by se ji měřit.
Na počátek bych dal :

Dim start As Double
Dim cil As Double
start = Now()
Application.ScreenUpdating = False
On Error GoTo LabelErr
Na konec bych dal:

cil = Now()
Debug.Print "Vyrobeno za : " & FormatDateTime(cil - start, vbLongTime)
LabelErr:
Application.ScreenUpdating = True

Na první pohled je to jen o rychlosti výpočtu a množství dat. To se moc nezrychlí.
Odstranil bych

Range("ba" & radek).Select

Select Ti nastaví aktuální buňku ... čili posouvá grafickou plochu aplikace a musí ji celou sestavit ... dooost času. Poku toto odstraníš, pak Ti obrazovka sice nebude poskakovat ale ušetříš spoustu času při velkém množství dat.

Zrychlení o délku jedne mouchy může být výměna

Dim aaa%
za
Dim aaa&

Integer je 16-ti bitové číslo a dnešní systémy jsou ryze 32-bitové (a vyšší). Převáděním se může ztrácet čas ... ale celkově je to na délku mouchy :)

Další jsou proměnné as1 at1 o1 apod. Nemáš je definované ... tudíž jsou variant a to je normální čas výpočtu krát 50 = moc moc moc. Definuj je podle toho co má vyjít. Pevné nebo realné číslo.

Poslední úvaha. Sice neznám data a okolnosti, ale já bych v případě výpočtu u velkého množství dat volil postup s vložením vzorců do buněk, vyplněním dolů a zkopírováním jako hodnoty. Znamená to rozložit, co se dá spočítat vzorcemi a zbytek projet makrem. Samozřejmě, je to více VB code, ale vzorce jsou několika násobně rychlejší než interpret VB.

Nejdříve vykomentuj Application.ScreenUpdating = false a zjisti za jak dlouho se to na aktuálních datech sestaví. Pak odstraň komentář a zruš .Select
R.

Mi to funguje na otevření i přes CTRL+SHIFT+B. R.

Zkusíme něco jiného.
V Excelu (2003) si najdiv Menu Nástroje->Makro->Makra (Nebo Alt+F8). V seznamu najdi jméno makra "stahovací1_Změnit" a jednou na něj klepni. Pak klepni na tlačítko Možnosti a stiskni "SHIFT + B". Pak to všechno potvrď a zavři. Na kterémkoliv listě zkus spustit kombinaci CTRL+SHIFT+B. Pokud se Ti nic nezobrazí, nebo to skončí chybou, pak se podívej na jména listu v sešitě a v makru ... jestli jsi v mezidobí nepřejmenoval listy :( Taky bych doporučil odstranit diaktriku v názvu procedury. R.

To se poddá ... aby ses taky něco naučil a né jen stupidně odevzdat a získat opravu, je vhodné si toto udělat sám. Je to velmi jednoduché.

Kontroluj si co děláš ... a postupuj podle návodu.

Udělal sis na makra Modul1 ... dobrá. V modulu oprav proceduru takto

Sub stahovací1_Změnit()
DialogSheets("Formulář škody").Show
End Sub

Najdi si okénko "VBA project"
Najdi v okně "VBA project" "ThisWorkbook"
Najdi v rozbalovacím seznamu "ComboBox(y)" výběr Workbook a Open - jak je psáno výše.
Vygeneruje se Ti prázdná procedura Workbook_Open do které vložíš volání procedury v "Modul1"

Private Sub Workbook_Open()
Call Module1.stahovací1_Změnit
End Sub

Nakonec si najdi v "MENU Excelu" dialog s Makry a nastav si zkratkovou klávesu pro vyvolání dialogu v době kdy to potřebuješ TY jako user a né jen při otevření sešitu.

Pak si vlož do listu, kde se ti zlíbí, malý obrázek a přiřaď mu makro stahovací1_Změnit. Uvidíš že se Ti to bude líbit.

Pak si uvědomíš, že dialog vlastně nemusíš vidět, a že je hezčí, když uvedený list prostě skryješ.

Vítej v klubu ...

Platí pro Excel 2003
- v Excelu ALT+F11
- V levo musí být okno "VBA Project" nebo mačkej CTRL + R
- Naklepej svůj sešit a v něm "ThisWorkbook"
- Nahoře jsou dva rozbalovací seznamy. V levém je (General) ... změň jej na Workbook
- V pravém si najdi "Open"
Vygeneruje se ti prázdná procedura Open ... dopiš do ní co potřebuješ ... tj spuštění formsu.

Private Sub Workbook_Open()
' Pozdrav při spuštění
MsgBox "Hallo world"
' Spuštění jiné procedury v jiném modulu (otevření formsu)
Module1.MojeProcedura
End Sub

Jednodužší je na makro nastavit kombinaci kláves a pak spouštět kdykoliv forms přes zkratkové klávesy. R.

cWorkData je moje konstanta ... mám ji definovanou jako GLOBAL CONST cWorkData = "List1" (např.)

pokud použiješ konstrukci with nejaký objekt pak již tento nemusíš psát a odkazuješ se na něj tečkou na počátku
tj
with Worksheets(cWorkData)
.Range("A1").value = "blabla"
end with

tento kousek kodu znamená, že chceš pracovat s excelovským listem podle jména v konstantě cWorkData a na tomto listu zapíšeš hodnotu do buňky A1. Není důležité, na kterém listu se nacházíš a "vždy" to bude fungovat.
Chyba kterou to hází je proto, že nezná proměnnou nebo konstantu cWorkData. R.

Docela mne to zajímá, zda se Ti to podaří nějak elegantně vyřešit. Dovolím si pár poznámek.

Mohlo by stačit testovat existenci souboru a pak nahrát forms a pokud zhavaruje, pak jej nezobrazit.

Call ThisWorkbook.VBProject.VBComponents("Menu").Export("C:\WINDOWS\Temp\ee.bas")
With OutSesit
.Activate
'.VBProject.VBComponents.Add (vbext_ct_MSForm)
.VBProject.VBComponents.Import ("C:\WINDOWS\Temp\ee.bas")
End With

OCX objekty jsou ve VBA dostupné přes import např.
VBAEditor.References.AddFromFile "C:\Program Files\Common Files\system\ado\msado15.dll"

Pokud OCX dodáš s XLS pak stačí nahrát a používat. Nic méně to má podobnou podmínku.
Abys mohl nahrát pak potřebuješ ve VBA v References aktivovat doplněk M.S.Office Extensibility
Nevím na čem to přesně závisí. V některých PC nebyl aktivovány a pokud jsem otevřel sešit, pak se aktivoval. V jiných PC zase vyžadoval ruční zaškrtnutí v References.

To správné řešení je asi přes dynamickou alokaci - vytvoření instance.
Dynamicky zjistit, zda je COM registrovaný a pak :
- Test OCX
- LoadLibraryRegister
- GetProcAddressRegister apod.
Potom máš objekt v paměti pak jen jej svážeš s formsem a vykreslíš. To je ale na delší program (fuj).

Důvod je v tom, že když otevřeš XLS, pak je jedno co si nastavíš. VBA si zkontroluje makra a najde to co nezná. Pak zařve.
Kdybys použil externí deklaraci (pokud to jde) pak můžeš zkusit podmíněné zavedení. To ale vím, že jde s DLL. Nevím jak je na tom OCX.

To proto by mne zajímalo zda to nejde jinak. Občas by se mi to taky hodilo. R.

Asi máš něco špatně. Zkus krokovat makro až k chybě a nebo pošli vzorek.

Do tohoto pole si můžeš vložit více listů najednou a najednou se zkopírují a vytvoří nový soubor.
Worksheets(Array("DATA", "PIVOT", "PIVOT 1", "PIVOT 2")).Copypokud je jen jeden stačí bez "array"Worksheets("DATA").Copy
Po uložení a uzavření souboru se vrátíš do předchozího souboru. Pokud bys byl jinde, můžeš primárně doplnit na konec makra
SrcSesit.Activatea vrátíš se do sešitu který chceš, který chceš.
Všimni jsi kdy nastavují "SET"
Po uzavření nesmíš použít OutSesit.??? Protože již neobsahuje instanci Workbook.
Čistejší by ještě bylo, kdyby jsi po uzavření sešitu dopsal set OutSesit = Nothing

Možná je otázka ... proč, když nemají vidět data, musí mít konti tabulku ??? ... jen úvaha. Pokud ji z nějakého důvodu skutečně nepotřebují pak by to šlo jen překopírovat do nového listu (sešitu) vizuálně jako konti tabulka. Třeba takto.

Sub Makro1()

' Označ a zkopíruj konti tab.
ActiveSheet.PivotTables("Tab2").PivotSelect "", xlDataAndLabel, True
Selection.Copy

' vyber nové místo
Workbooks.Add
Range("A1").Select

' vlož hodnoty
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' vlož formáty.
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

' zruš schránku
Application.CutCopyMode = False

' nastav první buňku
Range("A1").Select

End Sub

Ahoj. Vyber si co potřebuješ z této funkce.
- Vytváří nový adresář podle datumu nebo nakopíruje do existujícího adresáře
- Vytvoří (zkopíruje) více listů najednou
- Uloží pod datumem a jménem
- Pokud máš nějaký kommrimační program, pak se Ti vytvoří archív. Archív vytvářím proto, že konti tabulky jsou objemné ale dají se velmi dobře komprimovat. Po tomto volám funkci na sestavení a odeslání emailu. 7z je free a vypadá to moc hezky, když jej voláš z VBA. R.

Function uloz_sestavu_do_souboru()
Dim i As Long
Dim OutSesit As Workbook
Dim SrcSesit As Workbook

Dim fs As Object
Dim f As Object
Dim adresar As String
Dim NewFileName As String
Dim exc As String

On Error GoTo LabelErr
With Worksheets(cWorkData)
.Activate
Set fs = CreateObject("Scripting.FileSystemObject")

adresar = cPathFile & Format(Now(), "yyyy mm dd")

If Not fs.FolderExists(adresar) Then
fs.CreateFolder (adresar)
End If
'Set f = fs.GetFile(cPathFile)
End With

GoTo LabelOK
LabelErr:
MsgBox "Chyba : " & Err.Number & " - " & Err.Description
Exit Function
LabelOK:
On Error GoTo 0

Set SrcSesit = ActiveWorkbook

Worksheets(Array("DATA", "PIVOT", "PIVOT 1", "PIVOT 2")).Copy
Set OutSesit = ActiveWorkbook
SrcSesit.Activate

NewFileName = adresar & "\" & Format(Now(), "yyyy mm dd") & " - FG.xls"

' Call kopiruj_vba_kody

Application.DisplayAlerts = False
OutSesit.SaveAs Filename:=NewFileName
OutSesit.Close SaveChanges:=True
Application.DisplayAlerts = True

exc = cPath7z & "7zG.exe a """
exc = exc & adresar & "\" & Format(Now(), "yyyy mm dd") & " - FG.zip"" """
exc = exc & adresar & "\" & Format(Now(), "yyyy mm dd") & " - FG.xls"""

' Debug.Print exc

Call ChDir(cPath7z)
Call Shell(exc, 1)

' Nastav zpět adresář pro otevírání souborů.
Call ChDir("c:\GTable\")

End Function

"c:\program files\microsoft office\office11\xlstart\personal.xls" ... nebo podobná cesta - Když Tě ruší, tak jej smaž. Excel bude plně funkční i bez něj. R.

Zkus toto. Možná pomůže. Nemůžu otestovat.
=když(E8<D8;(E8-D8)*1440;(D8-E8)*1440)).

??? Nechceš náhodou počítat časy přes půlnoc ???

Lehký kalibr může být např. toto.Sub FiltrovanaOblast()
Range("B3:H3").AutoFilter
Range("B3").AutoFilter Field:=4, Criteria1:="=16913388"
i = Range("E65536").End(xlUp).Row
If i <= 3 Then
MsgBox ("Filtr je bez radku.")
Exit Sub
End If
Range("E4:E65536").Cells.SpecialCells(xlCellTypeVisible).Select
MsgBox "Prvni radek je " & Selection.Row
For Each c In Selection
If Not IsEmpty(c.Value) Then
s = s & c.Address & ","
End If
If c.Row > i Then Exit For
Next c
If s <> "" Then MsgBox ("Prosel jsem filtrovane data a nasel bunky " + vbCrLf + s)
End Sub
Může mít chybu v případě ... ???

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse