MS Excel

Téma: Formulář-po stisku uložit/duplicita/přepsat

Zaslal/a yardaz 15.10.2017 18:54

Řeším,hledám,dlouho
Na formuláři CommandButton ZAPSAT FAKTURU
po stisknutí:
a)vyhledá zda na listu není již faktura pod stejným číslem
b)je-li zobrazí MSGBOX/ PŘEPSAT-STORNO
c)po stisku PŘEPSAT přepíše v řádku hodnoty z formuláře

Private Sub CommandButton10_Click()

Dim iRow As Long
Dim ws As Worksheet
'''na jaký list zapsat obsah formuláře
Set ws = Worksheets("List1")

'''najde poslední prázdnou buňku
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

''existuje už v databazi?

Set ws = Worksheets("List1")
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'vyhledá zda není duplicitní číslo faktury
If WorksheetFunction.CounIf(Sheets("List1"), ws.Range("A12", ws.Cells(iRow - 1, 1)), TextBox9.Value) > 0 Then
Select Case MsgBox("Faktura pod tímto číslem již existuje", vbOKCancel, "UPOZORNĚNÍ")
Case vbOK
'po stisku "přepsat" přepíše data u čísla faktury
ws.Cells(lastrow, 1).Value = Me.TextBox9
ws.Cells(lastrow, 2).Value = Me.TextBox8
ws.Cells(lastrow, 3).Value = Me.TextBox1
ws.Cells(lastrow, 4).Value = Me.TextBox5
ws.Cells(lastrow, 5).Value = Me.TextBox3
ws.Cells(lastrow, 6).Value = Me.TextBox4
ws.Cells(lastrow, 7).Value = Me.TextBox6
ws.Cells(lastrow, 8).Value = CDbl(Me.TextBox7)
ws.Cells(lastrow, 9).Value = Format(TextBox10.Value, "dd.mm.yyyy")

Call Main 'Progress Bar

Unload Me
Application.ScreenUpdating = False
MsgBox "Záznam byl uložen do vydaných faktur", vbApplicationModal, "POTVRZENÍ"

Case vbCancel
'po stisknutí "storno"zavře dialog
End Select

End If

Sheets("List1").Select

'End With
End Sub

Zaslat odpověď >

yardaz(15.10.2017 18:55)#037969

Nezná někdo řešení?
Děkuji
Yardazcitovat

Jeza.m(16.10.2017 14:35)#037975

První kvůli čemu to nebude fungovat asi bude chybějící "t" ve funkci CountIf.

Jinak ...
Application.ScreenUpdating = False
Dim iRow As Long

Dim ws As Worksheet
Set ws = Worksheets("List1")
iRow = Sheets("List1").UsedRange.Rows.Count + 1

''existuje už v databazi?
If WorksheetFunction.CountIf(ws.Range("A:A"), TextBox9.Value) > 0 Then
Select Case MsgBox("Faktura pod tímto číslem již existuje, Přejete si ji přepsat?" & vbNewLine & "ANO = Přepsat" & vbNewLine & "NE = Zrušit zápis", vbYesNo + vbQuestion, "UPOZORNĚNÍ")
Case vbYes
iRow = WorksheetFunction.Match(TextBox9.Value, ws.Range("A:A"), False)
Case vbNo, vbCancel
Exit Sub
End Select
End If

ws.Cells(iRow, 1).Value = Me.TextBox9
ws.Cells(iRow, 2).Value = Me.TextBox8
ws.Cells(iRow, 3).Value = Me.TextBox1
ws.Cells(iRow, 4).Value = Me.TextBox5
ws.Cells(iRow, 5).Value = Me.TextBox3
ws.Cells(iRow, 6).Value = Me.TextBox4
ws.Cells(iRow, 7).Value = Me.TextBox6
ws.Cells(iRow, 8).Value = CDbl(Me.TextBox7)
ws.Cells(iRow, 9).Value = Format(TextBox10.Value, "dd.mm.yyyy")

Call Main 'Progress Bar

MsgBox "Záznam byl uložen do vydaných faktur", vbApplicationModal + vbInformation, "POTVRZENÍ"
Application.ScreenUpdating = True
Unload Me
Sheets("List1").Select

M@citovat

yardaz(17.10.2017 7:14)#037984

Jeza.m: Fantastické-Děkujicitovat

Téma: Formulář-po stisku uložit/duplicita/přepsat

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje