Ændre / Slet data i userform
Hej....Jeg har en Userform, som laver et opslag på nogle værdier som jeg har i et ark. Der er tre ark (køb, salg og renter). I Userformen er der en frame for henholdsvis ark køb, salg og renter. Når man laver et opslag (pt. er opslagsværdien bilagsnummeret) i en textbox, så bliver der i en listbox vist de bilag som er anført i arket. Når man begynder at indkredse sin søgning, bliver antallet af valgmuligheder i listboxen mindre. Jeg har i den forbindelse 3 udfordringer.
1. Vis ikke blanke værdier.
Listboxen viser blanke celler. Hvis jeg f.eks. i arket har følgende værdier:
2000
2001
Blank
2002
Så viser listboxen det samme som ovenfor. Kunne dog godt tænke mig, at den kun viste de celler der indeholdte en værdi. Kan man gøre noget ved dette?
2. Ikke visning af værdier i listbox.
I Framen Køb er alle bilagsnummer vist, hvilket også er ok (med undtagelse af ovenstående problem). Når man klikke på de øvrige frames (Salg og renter), så er listboxen tom, der kommer først noget frem, når man begynder at indtastet en værdi i textboxen, hvor opslagsværdien indtastes. Er det muligt, at man også kan få vist alle bilagsnummerne, som i Frame Køb?
3. Samme bilagsnummer
I nogle tilfælde vil samme bilagsnummer fremgår flere gange i samme ark. Når man taster et Bilagsnummer (opslagsværdien) ind i textboksen, og vælger bilaget i listboksen, så bliver de enkelte dataoplysninger vist, hvilket også er ok. Problemet er, hvis bilaget fremgår flere gange, så viser userformen dataoplysningerne på det bilagsnummer som står først. Er det muligt at man evt. kunne udvide søgningen yderligere, hvis dette var tilfældet. Det skal bemærkes at navnet vil være forskelligt, idet tilfælde der er flere bilag med samme bilagsnummer.?
Håber at ovenstående gav mening.
Nedenfor fremgår hele koden som er i Userformen.
-------------------------------------------------------------
Dim curcell As Range 'den aktuelle celle i kolonne A på arket Køb
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx KØB XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' ----------------------------------------- BOGFØR ÆNDRINGER -----------------------------------------------------
Private Sub CommandButton2_Click()
'slå skærmopdatering fra
Application.ScreenUpdating = False
'gem kun, hvis textbox1 er forskellig fra tom = der er søgt på et bilagsnummer
If UserForm4.TextBox1.Text <> "" Then
'gem ændringer i arket Køb ... foretaget i textboxene på userformen
curcell.Offset(0, 1).Value = UserForm4.TextBox1.Value
curcell.Offset(0, 2).Value = Format(UserForm4.TextBox2.Value, "dd. mmmm yyyy")
curcell.Offset(0, 3).Value = UserForm4.TextBox3.Value * 1
TextBox3.Value = Format(CDbl(TextBox3.Value), " #,##0.00")
curcell.Offset(0, 4).Value = UserForm4.TextBox4.Value * 1
TextBox4.Value = Format(CDbl(TextBox4.Value), " #,##0.00")
curcell.Offset(0, 5).Value = UserForm4.TextBox5.Value * 1
TextBox5.Value = Format(CDbl(TextBox5.Value), " #,##0.00")
curcell.Offset(0, 6).Value = UserForm4.TextBox6.Value * 1
TextBox6.Value = Format(CDbl(TextBox6.Value), " #,##0.00")
curcell.Offset(0, 0).Value = UserForm4.TextBox7.Value
End If
MsgBox "Du har nu fortaget ændringer i bilagsnummer: " & curcell.Text, vbInformation
Unload Me
ThisWorkbook.Save
'slå skærmopdatering til igen
Application.ScreenUpdating = True
End Sub
' ---------------------------------------------- SLET BILAG ----------------------------------------------------
Private Sub cmdSletRækkeP1_Click()
'slå skærmopdatering fra
Application.ScreenUpdating = False
'Hvis der ikke er valgt et bilagsnummer på listen
If UserForm4.lstBilagsNr.ListIndex = -1 Then
Exit Sub
Else
'slet hele række, hvori den aktuelle celle findes
curcell.EntireRow.Delete
'tøm textboxe på userformen
With UserForm4
.lstBilagsNr.RemoveItem (.lstBilagsNr.ListIndex)
.TextBox1.Text = ""
.TextBox2.Text = ""
.TextBox3.Text = ""
.TextBox4.Text = ""
.TextBox5.Text = ""
.TextBox6.Text = ""
.TextBox7.Text = ""
.txtSøgefelt.Text = ""
End With
'sæt tom linie som default
UserForm4.lstBilagsNr.ListIndex = -1
End If
MsgBox "Bilaget er nu slettet.", vbInformation
Unload Me
ThisWorkbook.Save
End Sub
' ------------------------------------------ SØG BILAG FREM --------------------------------------------------
Private Sub txtSøgefelt_Change()
Dim a As Integer 'tællevariabel
Dim c As Range 'objekt variabel
Dim talstreng As String 'variabel til talstreng
Dim talstrengsLængde As Variant 'variabel til længden på talstrengen
Dim talstrengLeft As Variant 'variabel til talstrengen fra venstre mod højre
Dim status As String 'txtSøgefelt status
'set status = værdien i textbox1
status = Me.txtSøgefelt.Text
'vælg udfra status
Select Case status
'hvis txtSøgefelt er tom
Case ""
'fyld listen med alle bilagsnumre fra kolonne A på arket Køb
For a = 2 To Sheets("Køb").Range("A65536").End(xlUp).row
'set C = den næste celle i kolonnen
Set c = Worksheets("Køb").Cells(a, 1)
UserForm4.lstBilagsNr.AddItem (c.Value)
Next
'sæt tom linie som default
UserForm4.lstBilagsNr.SetFocus
'tøm alle textboxe på userformen
With UserForm4
.TextBox1.Text = ""
.TextBox2.Text = ""
.TextBox3.Text = ""
.TextBox5.Text = ""
.TextBox6.Text = ""
.TextBox7.Text = ""
End With
'hvis txtSøgefelt ikke er tom
Case Else
'hele den aktuelle talstreng i txtSøgefelt
talstreng = Me.txtSøgefelt.Text
'aktuel talstrengs længde i txtSøgefelt
talstrengsLængde = Len(talstreng)
'aktuel talstreng fra venstre mod højre
talstrengLeft = Left(talstreng, talstrengsLængde)
'ryd listen
Me.lstBilagsNr.Clear
'fyld listen med bilagsnumre fra kolonne A på arket Køb
For a = 2 To Sheets("Køb").Range("A65536").End(xlUp).row
'set C = den næste celle i kolonnen
Set c = Worksheets("Køb").Cells(a, 1)
'Tjek cifre fra venstre i den aktuelle celleværdi på arket Køb
'Hvis de matcher de indtastede cifre i txtSøgefelt på userformen
If Left(c.Value, talstrengsLængde) = talstrengLeft Then
'tilføj den aktuelle celleværdi til listen
UserForm4.lstBilagsNr.AddItem (c.Value)
End If
Next
'giv txtSøgefelt fokus
Me.txtSøgefelt.SetFocus
End Select
End Sub
Private Sub lstBilagsNr_Change()
'slå skærmopdatering fra
Application.ScreenUpdating = False
Dim counter As Integer 'tælle variabel til cellerne i kolonne A på arket Køb
'for hver celle i kolonne A på arket Køb
'start i celle A2
For counter = 2 To Sheets("Køb").Range("A65536").End(xlUp).row
'set curcell = den næste celle i kolonnen
Set curcell = Worksheets("Køb").Cells(counter, 1)
'hvis den aktuelle celleværdi = værdien i testbox1 på userformen
If curcell.Text = UserForm4.lstBilagsNr.Value Then
'sæt textbox1 = værdien i den aktuelle celle (bilagsnummer)
UserForm4.TextBox1.Value = curcell.Text
'sæt textbox3 = værdien i cellen 1 til højre for den aktive celle
UserForm4.TextBox1.Text = curcell.Offset(0, 1)
'sæt textbox2 = værdien i cellen 2 til højre for den aktive celle
'formater værdien således: "dd. mmmm yyyy"
UserForm4.TextBox2.Text = Format(curcell.Offset(0, 2), "dd. mmmm yyyy")
'sæt textbox3 = værdien i cellen 3 til højre for den aktive celle
UserForm4.TextBox3.Text = Format(curcell.Offset(0, 3), " #,##0.00")
'sæt textbox4 = værdien i cellen 4 til højre for den aktive celle
UserForm4.TextBox4.Text = Format(curcell.Offset(0, 4), " #,##0.00")
'sæt textbox4 = værdien i cellen 5 til højre for den aktive celle
UserForm4.TextBox5.Text = Format(curcell.Offset(0, 5), " #,##0.00")
'sæt textbox4 = værdien i cellen 6 til højre for den aktive celle
UserForm4.TextBox6.Text = Format(curcell.Offset(0, 6), " #,##0.00")
'sæt textbox4 = værdien i cellen 7 til højre for den aktive celle
UserForm4.TextBox7.Text = curcell.Offset(0, 0)
'forlad proceduren
Exit Sub
End If
'næste celle i kolonne A på arket Køb
Next
'slå skærmopdatering til igen
Application.ScreenUpdating = True
End Sub
'---------------------------------- FORMATERING AF SØGEFELT (BILAGSNR) --------------------------------------
' ----- FORMATERING AF TALVÆRDI
Private Sub txtSøgefelt_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
'--------------------------------------- FORMATERING AF DATO--------------------------------------------------------------
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
'Dim dDate As Date
dDate = DateSerial(Year(Date), Month(Date), Day(Date))
TextBox2.Value = Format(TextBox2.Value, "d. mmmm yyyy")
dDate = TextBox2.Value
End Sub
'---------------------------------- FORMATERING AF NOMINEL BEHOLDNING --------------------------------------
'---- Tillad kun talværdi
Private Sub TextBox3_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
' ----- Formater til 0,00
Private Sub TextBox3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(TextBox3.Value) Then
TextBox3.Value = Format(CDbl(TextBox3.Value), " #,##0.00")
End If
End Sub
'---------------------------------- FORMATERING AF KURSVÆRDI -----------------------------------------------
'---- Tillad kun talværdi
Private Sub TextBox4_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
' ----- Formater til 0,00
Private Sub TextBox4_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(TextBox4.Value) Then
TextBox4.Value = Format(CDbl(TextBox4.Value), " #,##0.00")
End If
End Sub
'----------------------------- FORMATERING AF HANDELSOMKOSTNINGER --------------------------------------
'---- Tillad kun talværdi
Private Sub TextBo5_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
' ---- Formater til 0,00
Private Sub TextBox5_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(TextBox5.Value) Then
TextBox5.Value = Format(CDbl(TextBox5.Value), " #,##0.00")
End If
End Sub
'---------------------------------------- FORMATERING AF RENTER ---------------------------------------------
'---- Tillad kun talværdi
Private Sub TextBox6_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
' ---- Formater til 0,00
Private Sub TextBox6_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(TextBox6.Value) Then
TextBox6.Value = Format(CDbl(TextBox6.Value), " #,##0.00")
End If
End Sub
'--------------------------------------- FORMATERING AF BILAGSNR-------------------------------------------------
'---- Tillad kun talværdi
Private Sub TextBox7_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx SALG XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' ----------------------------------------- BOGFØR ÆNDRINGER -----------------------------------------------------
Private Sub cmbÆndre_Click()
'slå skærmopdatering fra
Application.ScreenUpdating = False
'gem kun, hvis textbox1 er forskellig fra tom = der er søgt på et bilagsnummer
If UserForm4.txtNavnPage2.Text <> "" Then
'gem ændringer i arket Køb ... foretaget i textboxene på userformen
curcell.Offset(0, 1).Value = UserForm4.txtNavnPage2.Value
curcell.Offset(0, 2).Value = Format(UserForm4.txtDatoPage2.Value, "dd. mmmm yyyy")
curcell.Offset(0, 3).Value = UserForm4.txtNominelPage2.Value * 1
txtNominelPage2.Value = Format(CDbl(txtNominelPage2.Value), " #,##0.00")
curcell.Offset(0, 4).Value = UserForm4.txtVærdiPage2.Value * 1
txtVærdiPage2.Value = Format(CDbl(txtVærdiPage2.Value), " #,##0.00")
curcell.Offset(0, 5).Value = UserForm4.txtOmkPage2.Value * 1
txtOmkPage2.Value = Format(CDbl(txtOmkPage2.Value), " #,##0.00")
curcell.Offset(0, 6).Value = UserForm4.txtRenterPage2.Value * 1
txtRenterPage2.Value = Format(CDbl(txtRenterPage2.Value), " #,##0.00")
curcell.Offset(0, 0).Value = UserForm4.txtBilagsnrPage2.Value
End If
MsgBox "Du har nu fortaget ændringer i bilagsnummer: " & curcell.Text, vbInformation
Unload Me
ThisWorkbook.Save
'slå skærmopdatering til igen
Application.ScreenUpdating = True
End Sub
' ---------------------------------------------- SLET BILAG ----------------------------------------------------
Private Sub cmbSletPage2_Click()
'slå skærmopdatering fra
Application.ScreenUpdating = False
'Hvis der ikke er valgt et bilagsnummer på listen
If UserForm4.lstBilagsNrPage2.ListIndex = -1 Then
Exit Sub
Else
'slet hele række, hvori den aktuelle celle findes
curcell.EntireRow.Delete
'tøm textboxe på userformen
With UserForm4
.lstBilagsNrPage2.RemoveItem (.lstBilagsNrPage2.ListIndex)
.txtNavnPage2.Text = ""
.txtDatoPage2 = ""
.txtNominelPage2 = ""
.txtVærdiPage2.Text = ""
.txtOmkPage2.Text = ""
.txtRenterPage2.Text = ""
.txtBilagsnrPage2.Text = ""
.txtSøgefeltPage2.Text = ""
End With
'sæt tom linie som default
UserForm4.lstBilagsNrPage2.ListIndex = -1
End If
MsgBox "Bilaget er nu slettet.", vbInformation
Unload Me
ThisWorkbook.Save
'slå skærmopdatering til igen
Application.ScreenUpdating = True
End Sub
' ------------------------------------------ SØG BILAG FREM --------------------------------------------------
Private Sub txtSøgefeltPage2_Change()
Dim a As Integer 'tællevariabel
Dim c As Range 'objekt variabel
Dim talstreng As String 'variabel til talstreng
Dim talstrengsLængde As Variant 'variabel til længden på talstrengen
Dim talstrengLeft As Variant 'variabel til talstrengen fra venstre mod højre
Dim status As String 'txtSøgefelt status
'set status = værdien i textbox1
status = Me.txtSøgefeltPage2.Text
'vælg udfra status
Select Case status
'hvis txtSøgefelt er tom
Case ""
'fyld listen med alle bilagsnumre fra kolonne A på arket Køb
For a = 2 To Sheets("Salg").Range("A65536").End(xlUp).row
'set C = den næste celle i kolonnen
Set c = Worksheets("Salg").Cells(a, 1)
UserForm4.lstBilagsNrPage2.AddItem (c.Value)
Next
'sæt tom linie som default
UserForm4.lstBilagsNrPage2.SetFocus
'tøm alle textboxe på userformen
With UserForm4
.txtNavnPage2.Text = ""
.txtDatoPage2 = ""
.txtNominelPage2 = ""
.txtVærdiPage2.Text = ""
.txtOmkPage2.Text = ""
.txtRenterPage2.Text = ""
.txtBilagsnrPage2.Text = ""
End With
'hvis txtSøgefelt ikke er tom
Case Else
'hele den aktuelle talstreng i txtSøgefelt
talstreng = Me.txtSøgefeltPage2.Text
'aktuel talstrengs længde i txtSøgefelt
talstrengsLængde = Len(talstreng)
'aktuel talstreng fra venstre mod højre
talstrengLeft = Left(talstreng, talstrengsLængde)
'ryd listen
Me.lstBilagsNrPage2.Clear
'fyld listen med bilagsnumre fra kolonne A på arket Køb
For a = 2 To Sheets("Salg").Range("A65536").End(xlUp).row
'set C = den næste celle i kolonnen
Set c = Worksheets("Salg").Cells(a, 1)
'Tjek cifre fra venstre i den aktuelle celleværdi på arket Køb
'Hvis de matcher de indtastede cifre i txtSøgefelt på userformen
If Left(c.Value, talstrengsLængde) = talstrengLeft Then
'tilføj den aktuelle celleværdi til listen
UserForm4.lstBilagsNrPage2.AddItem (c.Value)
End If
Next
'giv txtSøgefelt fokus
Me.txtSøgefeltPage2.SetFocus
End Select
End Sub
Private Sub lstBilagsNrPage2_Change()
'slå skærmopdatering fra
Application.ScreenUpdating = False
Dim counter As Integer 'tælle variabel til cellerne i kolonne A på arket Køb
'for hver celle i kolonne A på arket Køb
'start i celle A2
For counter = 2 To Sheets("Salg").Range("A65536").End(xlUp).row
'set curcell = den næste celle i kolonnen
Set curcell = Worksheets("Salg").Cells(counter, 1)
'hvis den aktuelle celleværdi = værdien i testbox1 på userformen
If curcell.Text = UserForm4.lstBilagsNrPage2.Value Then
'sæt textbox1 = værdien i den aktuelle celle (bilagsnummer)
UserForm4.txtNavnPage2.Value = curcell.Text
'sæt textbox3 = værdien i cellen 1 til højre for den aktive celle
UserForm4.txtNavnPage2.Text = curcell.Offset(0, 1)
'sæt textbox2 = værdien i cellen 2 til højre for den aktive celle
'formater værdien således: "dd. mmmm yyyy"
UserForm4.txtDatoPage2.Text = Format(curcell.Offset(0, 2), "dd. mmmm yyyy")
'sæt textbox3 = værdien i cellen 3 til højre for den aktive celle
UserForm4.txtNominelPage2.Text = Format(curcell.Offset(0, 3), " #,##0.00")
'sæt textbox4 = værdien i cellen 4 til højre for den aktive celle
UserForm4.txtVærdiPage2.Text = Format(curcell.Offset(0, 4), " #,##0.00")
'sæt textbox4 = værdien i cellen 5 til højre for den aktive celle
UserForm4.txtOmkPage2.Text = Format(curcell.Offset(0, 5), " #,##0.00")
'sæt textbox4 = værdien i cellen 6 til højre for den aktive celle
UserForm4.txtRenterPage2.Text = Format(curcell.Offset(0, 6), " #,##0.00")
'sæt textbox4 = værdien i cellen 7 til højre for den aktive celle
UserForm4.txtBilagsnrPage2.Text = curcell.Offset(0, 0)
'forlad proceduren
Exit Sub
End If
'næste celle i kolonne A på arket Køb
Next
'slå skærmopdatering til igen
Application.ScreenUpdating = True
End Sub
'--------------------------------------- FORMATERING AF DATO--------------------------------------------------------------
Private Sub txtDatoPage2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
'Dim dDate As Date
dDate = DateSerial(Year(Date), Month(Date), Day(Date))
TextBox2.Value = Format(TextBox2.Value, "d. mmmm yyyy")
dDate = TextBox2.Value
End Sub
'---------------------------------- FORMATERING AF NOMINEL BEHOLDNING --------------------------------------
'---- Tillad kun talværdi
Private Sub txtNominelPage2_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
' ----- Formater til 0,00
Private Sub txtNominelPage2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(txtNominelPage2.Value) Then
txtNominelPage2.Value = Format(CDbl(txtNominelPage2.Value), " #,##0.00")
End If
End Sub
'---------------------------------- FORMATERING AF KURSVÆRDI --------------------------------------
'---- Tillad kun talværdi
Private Sub txtVærdiPage2_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
' ----- Formater til 0,00
Private Sub txtVærdiPage2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(txtVærdiPage2.Value) Then
txtVærdiPage2.Value = Format(CDbl(txtVærdiPage2.Value), " #,##0.00")
End If
End Sub
'----------------------------- FORMATERING AF HANDELSOMKOSTNINGER --------------------------------------
'---- Tillad kun talværdi
Private Sub txtOmkPage2_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
' ---- Formater til 0,00
Private Sub txtOmkPage2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(txtOmkPage2.Value) Then
txtOmkPage2.Value = Format(CDbl(txtOmkPage2.Value), " #,##0.00")
End If
End Sub
'---------------------------------- FORMATERING AF RENTER --------------------------------------
'---- Tillad kun talværdi
Private Sub txtRenterPage2_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
' ---- Formater til 0,00
Private Sub txtRenterPage2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(txtRenterPage2.Value) Then
txtRenterPage2.Value = Format(CDbl(txtRenterPage2.Value), " #,##0.00")
End If
End Sub
'--------------------------------------- FORMATERING AF BILAGSNR-------------------------------------------------
'---- Tillad kun talværdi
Private Sub txtBilagsnrPage2_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
' xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx RENTER xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
' ----------------------------------------- BOGFØR ÆNDRINGER -----------------------------------------------------
Private Sub cmbÆndrePage3_Click()
'slå skærmopdatering fra
Application.ScreenUpdating = False
'gem kun, hvis textbox1 er forskellig fra tom = der er søgt på et bilagsnummer
If UserForm4.txtNavnPage3.Text <> "" Then
'gem ændringer i arket Køb ... foretaget i textboxene på userformen
curcell.Offset(0, 0).Value = UserForm4.txtBilagsnrPage3.Value
curcell.Offset(0, 1).Value = UserForm4.txtNavnPage3.Value
curcell.Offset(0, 2).Value = Format(UserForm4.txtDatoPage3.Value, "dd. mmmm yyyy")
curcell.Offset(0, 3).Value = UserForm4.txtKurs.Value
curcell.Offset(0, 4).Value = UserForm4.txtValuta.Value * 1
txtValuta.Value = Format(CDbl(txtValuta.Value), " #,##0.00")
curcell.Offset(0, 5).Value = UserForm4.txtBrutto.Value * 1
txtBrutto.Value = Format(CDbl(txtBrutto.Value), " #,##0.00")
curcell.Offset(0, 6).Value = UserForm4.txtUdbytteskat.Value * 1
txtUdbytteskat.Value = Format(CDbl(txtUdbytteskat.Value), " #,##0.00")
curcell.Offset(0, 7).Value = UserForm4.txtNetto.Value * 1
txtNetto.Value = Format(CDbl(txtNetto.Value), " #,##0.00")
'Kolonne 8 = Nettoudbytte i DKK
'Kolonne 9 = Udbytteskat i DKK
curcell.Offset(0, 10).Value = UserForm4.txtRefusion.Value
End If
MsgBox "Du har nu fortaget ændringer i bilagsnummer: " & curcell.Text, vbInformation
Unload Me
ThisWorkbook.Save
'slå skærmopdatering til igen
Application.ScreenUpdating = True
End Sub
' ---------------------------------------------- SLET BILAG ----------------------------------------------------
Private Sub cmbSletPage3_Click()
'slå skærmopdatering fra
Application.ScreenUpdating = False
'Hvis der ikke er valgt et bilagsnummer på listen
If UserForm4.lstBilagsNrPage3.ListIndex = -1 Then
Exit Sub
Else
'slet hele række, hvori den aktuelle celle findes
curcell.EntireRow.Delete
'tøm textboxe på userformen
With UserForm4
.lstBilagsNrPage3.RemoveItem (.lstBilagsNrPage3.ListIndex)
.txtNavnPage3.Text = ""
.txtDatoPage3 = ""
.txtBrutto = ""
.txtUdbytteskat.Text = ""
.txtRefusion.Text = ""
.txtNetto.Text = ""
.txtValuta.Text = ""
.txtBilagsnrPage3.Text = ""
.txtSøgefeltPage3.Text = ""
.txtKurs.Text = ""
End With
'sæt tom linie som default
UserForm4.lstBilagsNrPage3.ListIndex = -1
End If
MsgBox "Bilaget er nu slettet.", vbInformation
Unload Me
ThisWorkbook.Save
End Sub
' ------------------------------------------ SØG BILAG FREM --------------------------------------------------
Private Sub txtSøgefeltPage3_Change()
Dim a As Integer 'tællevariabel
Dim c As Range 'objekt variabel
Dim talstreng As String 'variabel til talstreng
Dim talstrengsLængde As Variant 'variabel til længden på talstrengen
Dim talstrengLeft As Variant 'variabel til talstrengen fra venstre mod højre
Dim status As String 'txtSøgefelt status
'set status = værdien i textbox1
status = Me.txtSøgefeltPage3.Text
'vælg udfra status
Select Case status
'hvis txtSøgefelt er tom
Case ""
'fyld listen med alle bilagsnumre fra kolonne A på arket Køb
For a = 2 To Sheets("Renter").Range("A65536").End(xlUp).row
'set C = den næste celle i kolonnen
Set c = Worksheets("Renter").Cells(a, 1)
UserForm4.lstBilagsNrPage3.AddItem (c.Value)
Next
'sæt tom linie som default
UserForm4.lstBilagsNrPage3.SetFocus
'tøm alle textboxe på userformen
With UserForm4
.txtNavnPage3.Text = ""
.txtDatoPage3 = ""
.txtBrutto = ""
.txtUdbytteskat.Text = ""
.txtRefusion.Text = ""
.txtNetto.Text = ""
.txtValuta.Text = ""
.txtBilagsnrPage3.Text = ""
.txtKurs.Text = ""
End With
'hvis txtSøgefelt ikke er tom
Case Else
'hele den aktuelle talstreng i txtSøgefelt
talstreng = Me.txtSøgefeltPage3.Text
'aktuel talstrengs længde i txtSøgefelt
talstrengsLængde = Len(talstreng)
'aktuel talstreng fra venstre mod højre
talstrengLeft = Left(talstreng, talstrengsLængde)
'ryd listen
Me.lstBilagsNrPage3.Clear
'fyld listen med bilagsnumre fra kolonne A på arket Køb
For a = 2 To Sheets("Renter").Range("A65536").End(xlUp).row
'set C = den næste celle i kolonnen
Set c = Worksheets("Renter").Cells(a, 1)
'Tjek cifre fra venstre i den aktuelle celleværdi på arket Køb
'Hvis de matcher de indtastede cifre i txtSøgefelt på userformen
If Left(c.Value, talstrengsLængde) = talstrengLeft Then
'tilføj den aktuelle celleværdi til listen
UserForm4.lstBilagsNrPage3.AddItem (c.Value)
End If
Next
'giv txtSøgefelt fokus
Me.txtSøgefeltPage3.SetFocus
End Select
End Sub
Private Sub lstBilagsNrPage3_Change()
'slå skærmopdatering fra
Application.ScreenUpdating = False
Dim counter As Integer 'tælle variabel til cellerne i kolonne A på arket Køb
'for hver celle i kolonne A på arket Køb
'start i celle A2
For counter = 2 To Sheets("Renter").Range("A65536").End(xlUp).row
'set curcell = den næste celle i kolonnen
Set curcell = Worksheets("Renter").Cells(counter, 1)
'hvis den aktuelle celleværdi = værdien i testbox1 på userformen
If curcell.Text = UserForm4.lstBilagsNrPage3.Value Then
'sæt textbox1 = værdien i den aktuelle celle (bilagsnummer)
UserForm4.txtNavnPage3.Value = curcell.Text
UserForm4.txtBilagsnrPage3.Text = curcell.Offset(0, 0)
'sæt textbox3 = værdien i cellen 1 til højre for den aktive celle
UserForm4.txtNavnPage3.Text = curcell.Offset(0, 1)
'sæt textbox2 = værdien i cellen 2 til højre for den aktive celle
'formater værdien således: "dd. mmmm yyyy"
UserForm4.txtDatoPage3.Text = Format(curcell.Offset(0, 2), "dd. mmmm yyyy")
UserForm4.txtKurs.Text = curcell.Offset(0, 3)
UserForm4.txtValuta.Text = Format(curcell.Offset(0, 4), " #,##0.00")
'sæt textbox3 = værdien i cellen 3 til højre for den aktive celle
UserForm4.txtBrutto.Text = Format(curcell.Offset(0, 5), " #,##0.00")
'sæt textbox4 = værdien i cellen 4 til højre for den aktive celle
UserForm4.txtUdbytteskat.Text = Format(curcell.Offset(0, 6), " #,##0.00")
UserForm4.txtNetto.Text = Format(curcell.Offset(0, 7), " #,##0.00")
'sæt textbox4 = værdien i cellen 5 til højre for den aktive celle
UserForm4.txtRefusion.Text = Format(curcell.Offset(0, 10), " #,##0.00")
'sæt textbox4 = værdien i cellen 6 til højre for den aktive celle
'forlad proceduren
Exit Sub
End If
'næste celle i kolonne A på arket Køb
Next
'slå skærmopdatering til igen
Application.ScreenUpdating = True
End Sub
'--------------------------------------- FORMATERING AF DATO--------------------------------------------------------------
Private Sub txtDatoPage3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
'Dim dDate As Date
dDate = DateSerial(Year(Date), Month(Date), Day(Date))
txtDatoPage3.Value = Format(txtDatoPage3.Value, "d. mmmm yyyy")
dDate = txtDatoPage3.Value
End Sub
'-------------------------------------------- FORMATERING AF BRUTTO----------------------------------------------------------
'---- Tillad kun talværdi
Private Sub txtBrutto_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
' ----- Formater til 0,00
Private Sub txtBrutto_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(txtBrutto.Value) Then
txtBrutto.Value = Format(CDbl(txtBrutto.Value), " #,##0.00")
End If
End Sub
'------------------------------------- FORMATERING AF UDBYTTESKAT----------------------------------------------------------
'---- Tillad kun talværdi
Private Sub txtUdbytteskat_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
' ----- Formater til 0,00
Private Sub txtUdbytteskat_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(txtUdbytteskat.Value) Then
txtUdbytteskat.Value = Format(CDbl(txtUdbytteskat.Value), " #,##0.00")
End If
End Sub
'------------------------------------- FORMATERING AF NETTOUDBYTTE----------------------------------------------------------
'---- Tillad kun talværdi
Private Sub txtNetto_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
' ----- Formater til 0,00
Private Sub txtNetto_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(txtNetto.Value) Then
txtNetto.Value = Format(CDbl(txtNetto.Value), " #,##0.00")
End If
End Sub
'------------------------------------- FORMATERING AF VALUTAKURS----------------------------------------------------------
'---- Tillad kun talværdi
Private Sub txtValuta_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
'Tillader kun tal, komma og minus
'Ascii 44 er komma, Ascii 45 er minus.
Select Case KeyAscii
Case 44 To 57
Case Else
KeyAscii = 0
End Select
End Sub
' ----- Formater til 0,00
Private Sub txtValuta_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(txtValuta.Value) Then
txtValuta.Value = Format(CDbl(txtValuta.Value), " #,##0.00")
End If
End Sub
