Příspěvky uživatele

Posílám v příloze příklad.

Jinak už jsem viděl úhlednější formulář :-)
Víš o tom že i prvky na formuláři si můžeš pojmenovat, třeba místo Combobox1 dát Prijmeni - ono pak se v tom lepe orientuje (ne uživateli, ale hlavne tvurci) ;-)

M@

Public Sub aktual()
'1) zakázat zobrazování změn (pro urychlení)
Application.ScreenUpdating = False
'2) zkopírovat buňky aktivního listu
Cells.Copy
'3) přepnout se na list Filtr
Sheets("Filtr").Activate
'4) vložit
Cells.PasteSpecial xlPasteAll
'5) spustit smyčku začínající 3. řádkem a končící posledním použitým řádkem
For rd = 3 To ActiveSheet.UsedRange.Rows.Count
'6) Podmínka když (buňka na řádku rd v 15. sloupci <> aktuální datum a buňka na řádku rd v 2. sloupci není prázdaná) nebo (buňka na řádku rd v 15. sloupci je prázdná a buňka na řádku rd v 1. sloupci je prázdaná) tak...
If (Cells(rd, 15) <> Date And Cells(rd, 2) <> "") Or (Cells(rd, 15) = "" And Cells(rd, 1) = "") Then
'...smaž řádek rd
Rows(rd).Delete
'...pokud je řádků víc než na kterém jsi tak znovu zkontroluj řádek rd (rd=rd-1)
If ActiveSheet.UsedRange.Rows.Count > rd Then rd = rd - 1
'konec podmínky
End If
'další kolo smyčky
Next
'7) povolit zobrazování změn
Application.ScreenUpdating = True
End Sub

Je-li to hlavně o vzorcích, tak když někdo nepovolí makra (které by mu zamkly list), tak je vysmátej :-).
Univerzální "demo" makro neznám, ale ten nejjednodušší způsob bude asi:
Private Sub Workbook_Open()
Dim exdatum As Date
exdatum = "26.7.2010"

If Date > exdatum Then
Cells.Locked = True
List1.Protect "heslo"
Else
List1.Unprotect "heslo"
End If

End Sub

M@

Ahoj,

záleží jak na tom jsi s makrama. Na odkaze níže je návod jak získat hodnotu ze zavřeného souboru:
http://spreadsheetpage.com/index.php/tip/a_vba_function_to_get_a_value_from_a_closed_file/

Mám otestované a fungovalo to, akorát jelikož jsem potřeboval spoustu dat, tak jsem nakonec řešil jinak, pomocí makra otevřít zdrojový soubor, zkopírovat data, zavřít zdrojový soubor - ono dostat větší objem dat je mnohem rychlejší z otevřeného souboru a když je to makrem a screenupdating = false, tak to skoro ani nepostřehneš.

M@

Pokus č.2

Tlačítko Filtruj -> list Filtr

M@

Nevím jak to dělají jiní, ale já mu musím říct co do kterého sloupce (číselně) zadat a jelikož nechci vše jako text, tak jdu ještě přes proměnné (P_... = pole formuláře, ..._X je proměnná:

Public Sub zapis()
Dim Jmeno_x As String
Dim Pocet_x As Single
Dim Jednotka_x As String
Dim Expedice_x As Date

Radek_a = List1.UsedRange.Rows.Count + 1

Jmeno_x = P_Jmeno
Pocet_x = P_Pocet
Jednotka_x = P_Jednotka
Expedice_x = P_Expedice

'Co do kterého sloupce (číselně sloupce 1,9,10,11)
Cells(Radek_a, 1) = Jmeno_x
Cells(Radek_a, 9) = Pocet_x
Cells(Radek_a, 10) = Jednotka_x
Cells(Radek_a, 11) = Expedice_x
End Sub

pokud by prvek na formuláři měl stejný název jako hlavička sloupce, tak by místo čísla sloupce šla použít funkce pozvyhledat, což by bylo univerzálnější v případě vložení nového sloupce, ale to moc neřeším :-).

M@

Ahoj,

postavil bych to trochu jinak a pak nejsou zapotřebí žádná makra.

V přiloženém souboru ve sloupci B si filtruješ stroj a ve sloupci S pak přes 1 fitruješ plán na aktuální den.

M@

Sešit do Accessu natáhneš, ale pouze hodnoty, vzorce a makra těžko (spíš než těžko bych řekl vůbec), místo vzorců je nutno použít dotazy a makra vytvořit nová pro access.

M@

Určitě by to šlo, ale zas jedině makrem, třeba při spuštění zkontrolovat datum a případně veškeré buňky zamknout, což pokud někdo při spuštění makra zakáže, tak vzorce budou normálně fungovat, makra už tedy ne, když budou zakázané. Když by makra byly povoleny, tak by se mohly zamknout buňky, což nezamkne makra, ty by musely obsahovat nějakou datovou podmínku na základě které se buď vykonají nebo hodí třebas hlášku, že zkušební doba demoverze vypršela.

M@

No třeba ve:
VB) App.EXEname vrátí název exe souboru z kterého je voláno.
Excel) Application.Name vrátí název aplikace ze které je voláno "Microsoft Excel"

tak APPNAME bude něco na ten způsob.

M@

Ahoj, tipoval bych to na jméno aplikace (APPlication NAME).
M@

Asi bude lepší příklad :-). V příloze jsou 2, jeden kontroluje právě zadanou hodnotu a druhý vždy celý sloupec.

M@

thisworkbook.path
vrátí cestu k aktuálnímu otevřenému souboru.

M@

rd mi symbolizuje číslo řádku.
Kdy se tam ta hodnota objeví, někdo ji napíše, nebo je to výsledek vzorce?

Asi by se to mohlo spouštět při:
je-li hodnota zadávána ručně.
Private Sub Worksheet_Change(ByVal Target As Range)
v tomto případě není nutno prohledávat celý sloupec, ale jen nově zadanou hodnotu.

je-li hodnota výsledkem vzorce.
Private Sub Worksheet_Calculate()

Jinak pro zabarvení buňky F3 stačí změnit
Cells(rd, 4).Interior.Color = vbRed
na
Cells(3, 6).Interior.Color = vbRed

M@

Že nepomohlo? :-)
A pomůže tohle:
With ActiveSheet.QueryTables.Add(Connection:=Array(Array("ODBC;DSN=Soubory Excel;DBQ=D:\POK.xls"), Array(";DriverId=790;MaxBufferSize=2048;PageTimeout=5")), Destination:=Range("A1"))
.CommandText = Array("SELECT `Data$`.pole_1, `Data$`.pole_2, `Data$`.pole_3, `Data$`.pole_4" & Chr(13) & "" & Chr(10) & "FROM `D:\POK`.`Data$` `Data$`" & Chr(13) & "" & Chr(10) & "WHERE (`Data$`.pole_1 = 'ABCD') ORDER BY `Data$`.pole_2")
.Name = "DB_Data"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
Soubor je D:\POK.xls a data jsou na listu Data, sloupce pak jsou Pole_1, Pole_2 ...
Nahrál jsem si makro a trochu to upravil.

M@

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje