Zaslal/a Martin12345678 6.2.2013 18:38
Ahoj, potřeboval bych poradit s níže uvedeným kódem. Nyní je nastaveno, že se data z UF uloží na další volný řádek. Lze nastavit, aby se nový zápis zapsal na první řádek a starší data se posouvala dolů. Je to možné? Díky za radu.
Private Sub CommandButton1_Click()
Dim list As String
list = ActiveSheet.Name
Sheets("Odběratel").Select
Dim Pocet_zaznamu, A, Novy_zaznam As Integer
Dim start, nazev, jmeno, ulice As String
Pocet_zaznamu = 490000
start = 1
For A = 1 To Pocet_zaznamu
nazev = Cells(start, 1)
jmeno = Cells(start, 2)
ulice = Cells(start, 3)
mesto = Cells(start, 4)
psc = Cells(start, 5)
telefon = Cells(start, 6)
ic = Cells(start, 7)
dic = Cells(start, 8)
Email = Cells(start, 9)
web = Cells(start, 10)
If nazev <> "" Or jmeno <> "" Or ulice <> "" Or mesto <> "" Or psc <> "" Or telefon <> "" Or ic <> "" Or dic <> "" Or Email <> "" Or web <> "" Then
start = start + 1
Else
Novy_zaznam = start
'MsgBox "Nový řádek = číslo " & start
GoTo 1
End If
Next A
1: 'MsgBox "Nový řádek = číslo " & start
If nazev_f = "" Then
Odpoved = MsgBox("Musíš zadat název odběratele", vbInformation + vbOKOnly, "Pozor")
nazev_f.SetFocus
If Odpoved = vbOK Then Exit Sub
Else
End If
If nazev_f = "" Then
Cells(start, 1) = "---"
Else
Cells(start, 1) = nazev_f
End If
If jmeno_f = "" Then
Cells(start, 2) = "---"
Else
Cells(start, 2) = jmeno_f
End If
If ulice_f = "" Then
Cells(start, 3) = "---"
Else
Cells(start, 3) = ulice_f
End If
If mesto_f = "" Then
Cells(start, 4) = "---"
Else
Cells(start, 4) = mesto_f
End If
If psc_f = "" Then
Cells(start, 5) = "---"
Else
Cells(start, 5) = psc_f
End If
If telefon_f = "" Then
Cells(start, 6) = "---"
Else
Cells(start, 6) = telefon_f
End If
If ic_f = "" Then
Cells(start, 7) = "---"
Else
Cells(start, 7) = ic_f
End If
If dic_f = "" Then
Cells(start, 8) = "---"
Else
Cells(start, 8) = dic_f
End If
If email_f = "" Then
Cells(start, 9) = "---"
Else
Cells(start, 9) = email_f
End If
If web_f = "" Then
Cells(start, 10) = "---"
Else
Cells(start, 10) = web_f
End If
Unload NovaEvidence
Worksheets(list).Activate
End Sub
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
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.