Zdravim,
kdybys prilozil ukazku, podival bych se na to...citovat
kdybys prilozil ukazku, podival bych se na to...citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Vstupní formulář
MS Excel
Téma: Vstupní formulář 
Zaslal/a MichalM 16.4.2010 11:00
Ahoj, nemohl by mi někdo poradit s banálním problémem?
Mám v excelu vytvořený seznam zákazníků, a formulář pro zadání nových.
Nevím jak pomocí makra zajistit, aby při zadání údajů do formuláře(ještě před tím než se přesunou data do tabulky) zkontrolovalo zda se již (třeba IČ) v tabulce neobjevuje.Myslím si, že toto téma se asi tady probíralo, ale nemohu najít konkrétní odpověď.(vzhledem k tomu, že data jsou zapsána zatím pouze ve formuláři)
Formulář je vlastní výroba. Pole pro zadání IČ má název "TextIco".
Děkuji za odpověď
Ahoj POKI. Soubor je součástí rozsáhlejší součástí, které nelze odeslat. Doufám, že bude stačit alespoň kód.
Private Sub CommandButton1_Click()
Dim DalsiRadek As Long
'Test zda je aktivní list Firmy
Sheets("Firmy").Activate
' Určení prvního prázdného řádku
DalsiRadek = Application.WorksheetFunction.CountA(Range("A:A")) + 1
' Poviné údaje, které musí být zadány
If TextIco = "" Then
MsgBox "Musíte zadat IČO"
Exit Sub
End If
If TextDic = "" Then
MsgBox "Musíte zadat DIČ"
Exit Sub
End If
If TextFNazev = "" Then
MsgBox "Musíte zadat název Firmy"
Exit Sub
End If
If TextFAdresa = "" Then
MsgBox "Musíte zadat Fakturační adresu"
Exit Sub
End If
If TextFMesto = "" Then
MsgBox "Musíte zadat Fakturační Město"
Exit Sub
End If
If TextFPsc = "" Then
MsgBox "Musíte zadat Fakturační PSČ"
Exit Sub
End If
If TextZapis = "" Then
MsgBox "Musíte zadat (Zapsán )"
Exit Sub
End If
' Zápis dat do buňky
If Not Worksheets("Firmy").Cells(Application.WorksheetFunction.CountA(Worksheets("Firmy").Range("A:A"))) = TextIco.Value Then
Cells(DalsiRadek, 1) = TextIco.Text
Else
MsgBox "IČO již existuje"
Exit Sub
End If
Cells(DalsiRadek, 2) = TextDic.Text
Cells(DalsiRadek, 3) = TextFNazev.Text
Cells(DalsiRadek, 4) = TextFAdresa.Text
Cells(DalsiRadek, 5) = TextFMesto.Text
Cells(DalsiRadek, 6) = TextFPsc.Text
Cells(DalsiRadek, 7) = TextFMesto6p.Text
Cells(DalsiRadek, 8) = TextDAdresa.Text
Cells(DalsiRadek, 9) = TextDMesto.Text
Cells(DalsiRadek, 10) = TextDPsc.Text
Cells(DalsiRadek, 11) = TextDMesto6p.Text
Cells(DalsiRadek, 12) = TextZapis.Text
Cells(DalsiRadek, 13) = TextJmeno.Text
Cells(DalsiRadek, 14) = TextFunkce.Text
Cells(DalsiRadek, 15) = TextOsloveni.Text
Cells(DalsiRadek, 16) = TextBucet.Text
Cells(DalsiRadek, 17) = TextTel.Text
Cells(DalsiRadek, 18) = TextFax.Text
'Vymazání pro další zadání
End Sub
Private Sub CommandButton2_Click()
' Ukončí Formulář Přidat Firmu
Unload UserPridatFirmu
End Sub
Děkuji za ochotu.citovat
Private Sub CommandButton1_Click()
Dim DalsiRadek As Long
'Test zda je aktivní list Firmy
Sheets("Firmy").Activate
' Určení prvního prázdného řádku
DalsiRadek = Application.WorksheetFunction.CountA(Range("A:A")) + 1
' Poviné údaje, které musí být zadány
If TextIco = "" Then
MsgBox "Musíte zadat IČO"
Exit Sub
End If
If TextDic = "" Then
MsgBox "Musíte zadat DIČ"
Exit Sub
End If
If TextFNazev = "" Then
MsgBox "Musíte zadat název Firmy"
Exit Sub
End If
If TextFAdresa = "" Then
MsgBox "Musíte zadat Fakturační adresu"
Exit Sub
End If
If TextFMesto = "" Then
MsgBox "Musíte zadat Fakturační Město"
Exit Sub
End If
If TextFPsc = "" Then
MsgBox "Musíte zadat Fakturační PSČ"
Exit Sub
End If
If TextZapis = "" Then
MsgBox "Musíte zadat (Zapsán )"
Exit Sub
End If
' Zápis dat do buňky
If Not Worksheets("Firmy").Cells(Application.WorksheetFunction.CountA(Worksheets("Firmy").Range("A:A"))) = TextIco.Value Then
Cells(DalsiRadek, 1) = TextIco.Text
Else
MsgBox "IČO již existuje"
Exit Sub
End If
Cells(DalsiRadek, 2) = TextDic.Text
Cells(DalsiRadek, 3) = TextFNazev.Text
Cells(DalsiRadek, 4) = TextFAdresa.Text
Cells(DalsiRadek, 5) = TextFMesto.Text
Cells(DalsiRadek, 6) = TextFPsc.Text
Cells(DalsiRadek, 7) = TextFMesto6p.Text
Cells(DalsiRadek, 8) = TextDAdresa.Text
Cells(DalsiRadek, 9) = TextDMesto.Text
Cells(DalsiRadek, 10) = TextDPsc.Text
Cells(DalsiRadek, 11) = TextDMesto6p.Text
Cells(DalsiRadek, 12) = TextZapis.Text
Cells(DalsiRadek, 13) = TextJmeno.Text
Cells(DalsiRadek, 14) = TextFunkce.Text
Cells(DalsiRadek, 15) = TextOsloveni.Text
Cells(DalsiRadek, 16) = TextBucet.Text
Cells(DalsiRadek, 17) = TextTel.Text
Cells(DalsiRadek, 18) = TextFax.Text
'Vymazání pro další zadání
End Sub
Private Sub CommandButton2_Click()
' Ukončí Formulář Přidat Firmu
Unload UserPridatFirmu
End Sub
Děkuji za ochotu.citovat
No tak jenom kod neni moc idealni, ale prijde mi, ze tam kontrolu na existujici ICO uz mas (aspon teda na poseldnim zapsanym zaznamu - da se zkontrolovat vse pomoci cyklu...)
Co teda vlasnte potrebujes?citovat
Co teda vlasnte potrebujes?citovat
Ahoj, máš pravdu je to
If Not Worksheets("Firmy").Cells(Application.WorksheetFunction.CountA(Worksheets("Firmy").Range("A:A"))) = TextIco.Value Then
Cells(DalsiRadek, 1) = TextIco.Text
Else
MsgBox "IČO již existuje"
Exit Sub
ale je nějaký nefunkční.
Testoval jsem to i na poslední řádek a nic. Jinak bych potřeboval zkontrolovat celý seznam (tak, že cyklem). Nemohl by jsi mi pomoc?
Děkujicitovat
If Not Worksheets("Firmy").Cells(Application.WorksheetFunction.CountA(Worksheets("Firmy").Range("A:A"))) = TextIco.Value Then
Cells(DalsiRadek, 1) = TextIco.Text
Else
MsgBox "IČO již existuje"
Exit Sub
ale je nějaký nefunkční.
Testoval jsem to i na poslední řádek a nic. Jinak bych potřeboval zkontrolovat celý seznam (tak, že cyklem). Nemohl by jsi mi pomoc?
Děkujicitovat
Podivat se na to muzu, ale jde to dost tezko bez moznosti otestovani, takze bych fakt potreboval ten soubor, kde je formular a seznam pro ulozeni dat...citovat
Ahoj POKI,
Tak jsem na rychlo vytvořil Testovací sešit s formulářem.
Předem děkuji za pomoc.
Michal
Tak jsem na rychlo vytvořil Testovací sešit s formulářem.
Předem děkuji za pomoc.
Michal
Příloha: 
1495_seznamfiremtest.zip (23kB, staženo 33x)
citovat1495_seznamfiremtest.zip (23kB, staženo 33x)co takhle?
Příloha: 1499_seznamfiremtest.zip (25kB, staženo 43x)
citovat1499_seznamfiremtest.zip (25kB, staženo 43x)POKI mám jenom malý dotaz:
V cyklu For i = 3 co znamená ta 3, proč tam je zrovna 3. Promiň za tu otázku teprve trénuju začátky.citovat
V cyklu For i = 3 co znamená ta 3, proč tam je zrovna 3. Promiň za tu otázku teprve trénuju začátky.citovat
I = 3 znamená, že cyklus začíná v bunce, A3 [cells(i,1) znamená: bunka i-tý řádek a 1. sloupec].
Tvoje data, ktera potrebujes porovnat jsou az do 3. radku.. tot vsecitovat
Tvoje data, ktera potrebujes porovnat jsou az do 3. radku.. tot vsecitovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
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.
RSS nejnovější články