05. marts 2007 - 21:03Der er
68 kommentarer og 1 løsning
Skrive værdier fra skjulte tekstbokse til excel og igen hente dem
Jeg er igang med at lave en userform, hvor det er meningen at få ensrette de informationer jeg modtager fra forskellige afsendere, så jeg nemmere kan arbejde videre med dem. Det er også meningen at man skal kunne redigere i de indtastede rækker igen og slette de rækker man ikke bruger mere.
Dertil har jeg lavet en userform med følgende tekstbokse, combobokse, labels og knapper.
Mine combobokse virker fint, når jeg vælger C-navn så har jeg bestemte muligheder i C-code.
Jeg kan også indtaste i alle tekstbokse og bruge alle combobokse og få værdierne ind på den rigtige række. Det er intet problem. JEg kan også få den til at undersøge om der er indtastet noget i feltet og så få den til at kaste besked tilbage hvis ikke der er indtastet noget.
Her finder den første tomme række. Som starter på i række 4. Række 3 er der overskrifter til de forskellige kolonner. Række 2 er tom. Række 1 er C-navn og dato.
JEg kunne i starten ikke få den til at springe række 2 over, men da jeg slettede linierne ved at gør hele arket hvidt og tegnede linierne op i arket så virkede det.
Problem: Når jeg vælger F-type så skal visse tekstbokse forsvinde fordi der ikke skal data i dem. I F-type har jeg 10 forskellige valg muligheder. Jeg har så forsøgt med en tekstboks til at starte på ved at give den væriden 0, men fordi boksen ikke er på min userform kan jeg ikke få den til at indtaste de andre værdier som er i de andre tekstbokse til regnearket.
Koden er som følgende:
'indeholder de 10 forskellige valg muligheder her er det max tekstboks den skal se bortfra hvis der vælges CCC. Private Sub F-type_Change() Select Case F-type.Text Case "CCC" With Max .Visible = False .Value = 0 End With Case Else Max.Visible = True End Select End sub
og unnder knappen:
Private Sub tilføj_Click() 'check for a Max er indtastet. If Max.Visible = True Then 'Max.Enabled = True If Trim(Me.Max.Value) = "" Then Me.Max.SetFocus MsgBox "Please enter max value" Exit Sub End If Else Max.visible = False Max.value = 0
Exit Sub End If
Men min Else sætning virker ikke. DVS. for det første så kommer der ingen værdier over i række 1 da max tekstboks er usynlig. Og for det andet så tager den ikke den værdi 0 med som jeg har givet den.
1)Hvad gør jeg forkert?
2) Kan jeg låse de combobokse så man ikke kan skrive i dem men skal vælge de værider jeg har taste ind i dem?
3) Kan jeg låse arket så man ikke kan indtaste uden at bruge userformen. Lige nu har start userform i ark 1 og indtastede værdier i ark 2. MEn trykker jeg og får userform frem så skal den også skfte til ark 2. Det virker også fint. Men jeg kan godt skrive i arket uden at bruge userformen.
4) Hvis jeg har data i række 4 til 8 og jeg ønsker at ændre i række 6 - hvordan vælger jeg så den række ud og indsætter værdierne i mine tekstbokse igen? Er godt med på at jeg nok skal have fat i en msg. boks med ja/nej muligheder og så en loop som køre igennem alle rækker til jeg finder den jeg vill ændre i. Hvordan koder jeg det?
5) hvordan sletter jeg en bestemt række som jeg udvælger. F.eks. række 5 - igen en loop og en msg. boks med ja/nej.?
6) Hvordan sikre jeg mig at det er tal der kommer i de rigtige tekstboks og at dato er ddmmåååå i dato tekstboksen og tekst i dem der skal være tekst i?
Til spg. 4 og 5 var det meningen jeg ville bruge nummer tekstboks men hvis jeg kan udlade at skulle give dem fortløbende nummer og bare vælge række er det meget bedre. Så kan jeg undvære den tekstboks.
Håber det er forståeligt hvad jeg mener og gerne vil have ellers kan jeg linke hele koden op. Er godt med på at det er mere eller mindre samme kode jeg kan genbruge til at gøre tekstboksene usynlige og give dem værdien 0 eller "-". Har også tænkte på om jeg skal lægge et excelark i bunden af userformen og så indsætte en knap der uploader de indtastede rækker til excel senere og det samme når jeg skal ændre/slette i en række. Hvad er bedst praksis?
4. Du har formentlig en unik værdi i en af cellerne, som er forskellig fra de andre rækker, f.eks. i A kolonnen. Læs A kolonnen ind i en comboboks, vælg så rækken der, og få de andre til at læse tilhørende celler.
Jeg har bare kaldet den max her men bruger txtmaximum til den textbox.
Har prøvet med Me.max.visible , men når jeg trykker på knappen så sker der intet. Den indsætter ikke de resterende txtbokse værdier på de pladser + 0 fra den skjulte boks.
Jeg ved boksen har fået værdien 0, men der sker bare intet. Har nu prøvet at indsætte Me foran dem jeg endnu ikke havde det ved. Hjælper desværre ikke..
Hvis jeg bruger den proctection metode som du nævner, så kommer der en messengerboks op som spørger efter kodeord.
Jeg bruger FrmBO.Show False i UserForm_Initialize() for at få den til at åbne op i ark 2. Hvis jeg ikke bruger false så åbner den op i ark 1.
Problemet er så også bare at når userformen er åben så kan jeg også indtaste ved siden af userformen i selve ark 2. Jeg kan ikke have userformen til at fylde over hele ark 2 da jeg gerne vil have man kan se hvad der kommer ind på de rigtige rækker.
Fik løst mit lille problem.. Så nu kan jeg vælge CCC i min comboboks og så skjuler den txtmax tekstboksen i min userform og den indsætter kun de værdier der er i de andre bokse + det 0 jeg har givet min skjulte boks.
Det der skulle til var denne lille kodestump .value = Null i F-type comboboks. Dermed kunne jeg slette det andet under min knap så resultatet blev følgende.
Private Sub F-type_Change() Select Case F-type.Text Case "CCC" With txtMax .Visible = False .Value = 0 End With Case Else With Me.txtMax .Visible = True .value = Null End With End Select End sub
og unnder knappen:
Private Sub tilføj_Click() 'check for a Maximum er indtastet. If Trim(Me.txtMax.Value) = "" Then Me.txtMax.SetFocus MsgBox "Please enter max value" Exit Sub End If Else Exit Sub
Nu mangler jeg bare spg. 2,4, 5 og 6, så er den fuldendt. Jeg bruger nok en comboboks til at erklære en værdi i kolonne A. Så kan jeg bruge den til at hente de resterende felter frem. Medmindre der er en der har en løsning hvor man bruger excels rækkeværdier 1,2,3,4,5,6,7,8,9 osv.
Kabbak det virker indtil videre med dine løsninger, så kan du måske også hjælpe med denne..
For det første skal jeg have lavet lidt kode i min cbonumber, så den kigger på om det nummer man vil bruge er brugt i arket. Er det ikke kan man vælge det og gerne fortløbende nummere. Cbonumber inderholder pt. tal fra 1-100. Og man skal altid starte med nummer 1 osv, så værdierne bliver unikke for hver række..
Til min slette funktion er det så meningen at man med cbonumber kan vælge et nummer som er repræsenteret i arket og så skal den gå ind og slette den bestemte række.
Her er det så min kode giver op..
Private Sub Cmdbdelete_Click()
Dim i As Integer Dim iRow As Long
Worksheets("Rapport - under udvikling").Unprotect
If Trim(Me.CboNumber.Value) = "Choose a Number" Then Me.CboNumber.SetFocus MsgBox "Please choose a number to delete" Exit Sub End If
If ActiveWorkbook Is Nothing Then Exit Sub i = MsgBox("YES: Delete number" & Chr(13) & _ "NO: Choose another number to delete", _ vbQuestion + vbYesNoCancel, "")
Select Case i Case vbYes Me.CboNumber.Value = "Choose a number" If Me.CboNumber.Value = "Choose a number" Then MsgBox ("Row deleted") 'Hvis man trykker YES uden at vælge så siger den også man har slettet. Det skal den ikke.. Else For iRow = Range("A65536").End(xlUp).Row To 1 Step -1
If Me.CboNumber.Value = Sheets("Rapport - under udvikling").Cells(iRow, 1).Value Then
Cells(iRow, 1).EntireRow.Delete End If
Next iRow
End If Case vbNo Me.CboNumber.Value = "Choose a number"
If Trim(Me.CboNumber.Value) >= 1 Then Me.CboNumber.SetFocus MsgBox (" Cancel!") Exit Sub End If
Case vbCancel Me.CboNumber.Value = "Choose a number"
End Select
Worksheets("Rapport - under udvikling").Protect End Sub
Dim i As Integer Dim iRow As Long Worksheets("Rapport - under udvikling").Unprotect
If Trim(Me.CboNumber.Value) = "Choose a Number" Then Me.CboNumber.SetFocus MsgBox "Please choose a number to delete" Exit Sub End If
' If ActiveWorkbook Is Nothing Then Exit Sub i = MsgBox("YES: Delete number" & Chr(13) & _ "NO: Choose another number to delete", _ vbQuestion + vbYesNoCancel, "")
Select Case i Case vbYes If Me.CboNumber.Value <> "Choose a number" Then For iRow = Sheets("Rapport - under udvikling").Range("A65536").End(xlUp).Row To 1 Step -1 If Me.CboNumber.Value = Sheets("Rapport - under udvikling").Cells(iRow, 1).Text Then Sheets("Rapport - under udvikling").Cells(iRow, 1).EntireRow.Delete MsgBox ("Row deleted") 'Hvis man trykker YES uden at vælge så siger den også man har slettet. Det skal den ikke.. End If
Next iRow
End If Case vbNo Me.CboNumber.Value = "Choose a number"
If Trim(Me.CboNumber.Value) >= 1 Then Me.CboNumber.SetFocus MsgBox (" Cancel!") Exit Sub End If
Case vbCancel Me.CboNumber.Value = "Choose a number"
End Select
Worksheets("Rapport - under udvikling").Protect End Sub
Private Sub UserForm_Click()
End Sub
>> sådan opdater du en combo når userformen starter, men du skal nok også smide linien ind under hoden hvor du tilføjer data, så er den altid opdateret.
Private Sub UserForm_Initialize() Me.CboNumber.RowSource = Range("A2").Address & ":" & Range("A65536").End(xlUp).Address End Sub
I min Sub userform_Activate() har jeg alle data på min combobokse, så er det ikke nødvendigt at køre den kode du har til UserForm_Initialize()..
Jeg har ændret lidt i koden, så nu kontrollere den først om tallet er brugt i excel arket, og er det det, skal man vælge et nyt nummer. Samt den har fået tilknyttet en ny funktion så man også kan fortryde sine indtastninger.
udkast af koden indeholder kun koden hvis man vælger YES knappen.
Select Case i Case vbYes If Me.CboNumber.Value = "Choose a number" Then MsgBox ("Please choose a number!") Else If iRow <> Me.CboNumber.Value Then MsgBox ("The number doesn't exist!") Me.CboNumber.Value = "Choose a number" Else If Me.CboNumber.Value <> "Choose a number" Then For iRow = Sheets("Rapport - under udvikling").Range("A65536").End(xlUp).Row To 1 Step -1 If Me.CboNumber.Value = Sheets("Rapport - under udvikling").Cells(iRow, 1).Text Then Sheets("Rapport - under udvikling").Cells(iRow, 1).EntireRow.Delete End If Next iRow End If End If End If
Når jeg indtaster data vil jeg gerne have, når jeg trykker på knappen "indsæt data" at den køre en lykke på nummeret indtil man vælger et nummer der ikke er brugt.
Jeg har under selve cboboksen number samme kode, bare uden at den springer tilbage til "Choose a number" - hvis man vælger en nummer der er brugt i arket. Det er fordi jeg gerne vil have at man skal kunne ændre i de samme felter senere.
Men jeg har kan ikke få min DO UNTIL LOOP til at virke. Nogen der kan se hvad der skal gøre her??
Private Sub EnterDataCmdB_Click()
Dim cRow As Long Dim i As Integer
'check for a number If cRow = Me.CboNumber.Value Then Do Until Me.CboNumber.Value <> "Choose a number" For cRow = Sheets("Rapport - under udvikling").Range("A65536").End(xlUp).Row To 1 Step -1 If Me.CboNumber.Value = Sheets("Rapport - under udvikling").Cells(cRow, 1).Text Then If ActiveWorkbook Is Nothing Then Exit Sub i = MsgBox("Warning!! Number is used!" & Chr(13), _ vbQuestion + vbOKCancel, "") Select Case i Case vbOK Me.CboNumber.Value = "Choose a number" Me.CboNumber.SetFocus Case vbCancel Me.CboNumber.Value = "Choose a number" End Select End If Next cRow Loop End If
Den skal blive ved med at loop på ok indtil man har valgt et nummer der ikke er brugt.
Jo, det kunne jeg måske. Det skal bare være muligt at ændre i rækken og slette nummeret.
Med fortløbende nummere så opdateres listen i comboboxen efterhånden som man nummerere eller hvad?
Hvad så hvis jeg sletter et nummer, bortfalder det så fra listen og er ledigt igen?
Lige nu har jeg oprettet en combobox med 100nummere i. Det skulle være rigeligt idet de kan genbruges efterhånden som de bliver slettet igen ellers er det ikke værre end jeg kan oprette flere rækker hvis behovet er til det.
Pt. tror jeg det nemmeste er at lave en lykke do/while eller anden type. Den må bare ikke hoppe ud før den har fundet et ledigt nummer..
Et forslag, lav en combo, med ledige numre, her kaldet CboNewNumber, så kan man ikke vælge et nummer der er brugt.
Find et sted i dine koder, hvor du kan kalde underliggende kode, så den altid er opdateret, det vil sige efter slerning af rækker og efter nye data.
Du kalder den ved at skrive
OpdaterUbrugte
Private Sub OpdaterUbrugte() Dim NewData(100) As Variant, Data As Variant, I As Integer Data = Sheets("Rapport - under udvikling").Range(Range("A2"), Sheets("Rapport - under udvikling").Range("A65536").End(xlUp)) For I = 1 To 100 NewData(I) = I Next
For I = 1 To UBound(Data) NewData(Data(I, 1)) = Empty Next
For I = 1 To UBound(NewData) If Not IsEmpty(NewData(I)) Then Me.CboNewNumber.AddItem I Next End Sub
Du har de brugte i Me.CboNumber og de ubrugte i Me.CboNewNumber
I den måde du prøvede på, skulle man jo gætte på hvilkan var ledig. Man kunne måske lave så at den automatisk valgte første ledige nummer, hvis du synes. ?
Din kode fra 09/03-2007 14:22:25, erstattes af nedstående linie, du skal bare lave ' Me.Label1.Caption', om til hvor du bruger værdien
Me.Label1.Caption = NytNummer
Private Function NytNummer() Dim NewData(100) As Variant, Data As Variant, I As Integer Data = Sheets("Rapport - under udvikling").Range(Range("A2"), Sheets("Rapport - under udvikling").Range("A65536").End(xlUp)) For I = 1 To 100 NewData(I) = I Next
For I = 1 To UBound(Data) NewData(Data(I, 1)) = Empty Next NytNummer = WorksheetFunction.Min(NewData) End Function
Ok, nej det vil blive for besværlig med en løsning over 2 bokse.
Min måde er ikke at den skal gætte. Jeg kan sagtens få den til at fortælle mig om tallet er brugt eller ej, som en slags warning, når jeg vælger tallet.
Meningen var at den, når jeg trykker på tilføj ny data, så skal den køre en lykke hvori den skal se på det nummer jeg har valgt og så sammenligne det med de nummere der er brugt. Er nummeret ikke brugt kan den tilføje og omvendt igennem en msgbox.
Den anden ide jeg hår fået af det du nævnte om skjulte tal. Er om det var muligt, at når man har valgt et tal i comboboksen og de blivere skrevet ind i arket, at så skal de skjules efterfølgende indtil rækken bliver slettet igen.
Dermed havde jeg tænkt mig at jeg kunne fremkalde tallene igennem en inputboks når dataene skal opdateres i en ny knap.
Jeg har også siddet og leget lidt med om det var muligt at skrive de brugt tal med fed skrift og de ubrugte med alm skrifttype. Men jeg har indtil videre kun haft held til at vælge mellem intet eller alle med fed.
Jeg vil dog lige prøve din kode..
Har du været udsat for at efter man ha sendt en kode til fyr der ville gi 150point, så 3 timer senere så lukker han tråden og siger han ikke har brugt ens løsning.. Det er da fortræls at bruge tid på sådanne folk..
Til det sidste du skriver, desværre ja, jeg er begyndt at tjekke om spørgerne, om deres vane med at tage point selv , dem hopper jeg så udenom. Envidere ser jeg om de har mange spørgsmål åbne, hvis de har det, beder jeg dem om at få dem afsluttet, inden jeg vil hjælpe.
Jeg tror at den sidste løsning jeg sendte, er den der opfylder dit krav, den finder jo automatisk det første ledige nummer.
Den funktion med automatisk nummering er super duper.. Har rettet min delete knap til.. Så nu er comboboksen med nummere røget ud. Det her gør det noget nemmere. Har også fået den til at opdatere nummeret på userformen så den viser først ledige nummer. Kan man sortere disse nummere f.eks. efter man har slettet 5 mellem 4 og 6 og så indsætter 5 igen. Så vil række følgen være 4,6,5 - kan det sorteres?
Et hurtigt spørgsmål - en hurtig måde at hente en celleværdi tilbage til en tekstboks?
Og så det sidste spørgsmål - kan man få dette auto nummer til at bruge den nummerering der er i excels ark, der er i venstre side??
"Kan man sortere disse nummere f.eks. efter man har slettet 5 mellem 4 og 6 og så indsætter 5 igen. Så vil række følgen være 4,6,5 - kan det sorteres?"
Hvad mener du, er det rækkefølgen i min function, du mener, den er altid sorteret.
"Et hurtigt spørgsmål - en hurtig måde at hente en celleværdi tilbage til en tekstboks?"
textbox1.text = Range("A2")
"Og så det sidste spørgsmål - kan man få dette auto nummer til at bruge den nummerering der er i excels ark, der er i venstre side??"
Punkt 1 - Ja den virker sådan set fint. Men hvis jeg f.eks opretter rækkerne 1,2,3,4,5,6. Og bagefter sletter række 4 så række 5 bliver til række 4 osv. Så vil den næste gang den bruger et nummer tag nummer 4 fordi det er det første ledige nummer. Så er det jeg tænker om man så kan sortere efterfølgende så der igen står 1,2,3,4,5,6. Er du med??
Punkt 2 - tak..
Punkt 3 - Jeps rækkenummerne, de står der jo alligevel, så jeg ikke skal bruge en kolonne på nummerering.
Punkt 4 - Hvis jeg har 01-02-2007 og sletter bagfra så der står 01-02-20 så kommer den med en fejl i denne kode:
Private Sub txtDate_change() Worksheets("Rapport - under udvikling").Unprotect
With txtDate Select Case Len(.Value) Case 4 .Value = Format(DateValue(Mid(.Value, 1, 2) & "-" & Mid(.Value, 3, 2) & "-" & Year(Date)), "dd-mm-yyyy") Case 6 .Value = Format(DateValue(Mid(.Value, 1, 2) & "-" & Mid(.Value, 3, 2) & "-" & Mid(.Value, 5, 2)), "dd-mm-yyyy") Case 8 .Value = Format(DateValue(Mid(.Value, 1, 2) & "-" & Mid(.Value, 3, 2) & "-" & Mid(.Value, 7, 2)), "dd-mm-yyyy") Case Else GoTo Final End Select If UCase(.Value) = "DD" Then .Value = Format(Date, "dd-mm-yyyy") '[a1] = DateValue(.Value) End With Final: Worksheets("Rapport - under udvikling").Protect End Sub
Den kode du lagde op med autonummering, den bliver ved med at komme op med en mismatch selvom det intet er i rækkerne.
De tre første rækker skal den springe over - de tommer felter starter ved A4.
Jeg har før haft indsat Me.Number1.Caption = Number i Sub userform_Activate(), men den brokker sig når jeg har denne linie i Activate. Men jeg ska jo have den for at opdatere number.
Private Function Number() Dim NewData(500) As Variant, Data As Variant, I As Integer Data = Sheets("Rapport - under udvikling").Range(Range("A4"), Sheets("Rapport - under udvikling").Range("A65536").End(xlUp)) For I = 1 To 500 NewData(I) = I Next
For I = 1 To UBound(Data) NewData(Data(I, 1)) = Empty 'hænger her!!!! = mismatch Next Number = WorksheetFunction.Min(NewData) Me.Number1.Font.Bold = True End Function
Private Function Number() Dim NewData(500) As Variant, Data As Variant, I As Integer
If Sheets("Rapport - under udvikling").Range("A65536").End(xlUp) >= 4 Then
Data = Sheets("Rapport - under udvikling").Range(Range("A4"), Sheets("Rapport - under udvikling").Range("A65536").End(xlUp)) For I = 1 To 500 NewData(I) = I Next
For I = 1 To UBound(Data) NewData(Data(I, 1)) = Empty 'hænger her!!!! = mismatch Next End If Number = WorksheetFunction.Min(NewData) Me.Number1.Font.Bold = True End Function
Private Function Number() Dim NewData(500) As Variant, Data As Variant, I As Integer
Data = Sheets("Rapport - under udvikling").Range(Range("A4"), Sheets("Rapport - under udvikling").Range("A65536").End(xlUp)) For I = 1 To 500 NewData(I) = I Next
If Sheets("Rapport - under udvikling").Range("A65536").End(xlUp) >= 4 Then
For I = 1 To UBound(Data) NewData(Data(I, 1)) = Empty 'hænger her!!!! = mismatch Next End If Number = WorksheetFunction.Min(NewData) Me.Number1.Font.Bold = True End Function
Jeg kunne slet ikke få den til at køre i min userform.. Ved ikke hvad der skete, for den virkede fint indtil jeg opdagede den startede i række 2. Jeg ændrede også i min sletfunktion idet den startede fra række 1..
Opdage endnu en fejl, den tjekker fra række 4 det burde din slettefunktion så også laves til at gøre.
Private Function Number() Dim NewData(500) As Variant, Data As Variant, I As Integer
Data = Sheets("Rapport - under udvikling").Range(Range("A4"), Sheets("Rapport - under udvikling").Range("A65536").End(xlUp)) For I = 1 To 500 NewData(I) = I Next
If Sheets("Rapport - under udvikling").Range("A65536").End(xlUp).Row >= 4 Then
For I = 1 To UBound(Data) NewData(Data(I, 1)) = Empty Next End If Number = WorksheetFunction.Min(NewData) Me.Number1.Font.Bold = True End Function
Et andet problem jeg køre lidt rundt i, er når jeg i min cboFac vælger en værdi som så åbner op for muligheden i cboCur. Så kan jeg ikke få den til at indsætte disse værdier i excel. Dataene vil ikke forlade min userform.
Under min Enter knap for cboCur er bla.:
Private Sub EnterCmdB_Click()
Set ws = Worksheets("Rapport - under udvikling") Worksheets("Rapport - under udvikling").Unprotect
If Me.cboCur.Enabled = True Then If Trim(Me.cboCur.Value) = "Choose Cur" Then Me.cboCur.SetFocus MsgBox "Please choose cur" Else If Me.cboCur.Enabled = False Then GoTo Final End If End If Exit Sub End If Final:
'check for a Max If Me.txtMax.Enabled = True Then If Trim(Me.txtMax.Value) = "" Then Me.txtMax.SetFocus MsgBox "Please enter Max value" ElseIf Me.txtMax.Enabled = False Then GoTo Final1 End If Exit Sub End If Final1:
'check for a outstanding amount If Me.txtAct.Enabled = True Then If Trim(Me.txtAct.Value) = "" Then Me.txtAct.SetFocus MsgBox "Please enter outstanding amount" ElseIf Me.txtAct.Enabled = False Then GoTo Final2 End If Exit Sub End If Final2:
With ws .Cells(iRow, 4).Value = Me.cboFac.Value .Cells(iRow, 5).Value = Me.cboCur.Value .Cells(iRow, 6).Value = Me.txtMax.Value .Cells(iRow, 7).Value = Me.txtAct.Value .Cells(iRow, 14).Value = Me.txtComments.Value End With
With Me .txtMax.Value = "" .txtAct.Value = "" .txtComments.Value = "" .cboName.SetFocus End With Worksheets("Rapport - under udvikling").Protect End Sub
Hvad er det der gør at den ikke vil indsætte den værdi jeg vælger i cboCur og hvorfor køre lykken ikke rigtigt i cboFac_change??
Det er nemlig et gennemgående problem i min cboFac.
Private Sub cbofac_change()
If Me.cboFac = "Choose Fac" Then Me.cboCur.Enabled = False Me.CurLabel.Enabled = False Else Me.cboCur.Enabled = True Me.CurLabel.Enabled = True End If End Sub
Select Case Me.cboFac.Text Case "CC" Me.txtMax.Enabled = True Me.txtMax.Value = "" Me.txtAct.Enabled = True Me.txtAct.Value = "" Me.txtComments.Enabled = True 'Den bliver herned og ser ikke på de andre to. Me.txtComments.Value = "" Case Else Me.txtMax.Enabled = False Me.txtMax.Value = "" Me.txtAct.Enabled = False Me.txtAct.Value = "" Me.txtComments.Enabled = False Me.txtComments.Value = "" End Select
End Sub
Som du indirekte kan se er der 3 txtbokse der er skjult fra starten under min Sub userform_Activate(), det er derfor jeg enabler dem, når man vælger en værdi under cboFac.
Problemt er, at den ikke vil skiftet mellem de forskellige værdier under cboFac - kun comments virker. Og den vil hellere ikke skrive værdien over i excel. Hvorfor??
Nor der ikke er valgt noget i comboen, skal du afbryde din kode.
Din kode: If Me.cboCur.Enabled = True Then If Trim(Me.cboCur.Value) = "Choose Cur" Then Me.cboCur.SetFocus MsgBox "Please choose cur" Else If Me.cboCur.Enabled = False Then GoTo Final End If End If Exit Sub End If
Burde være: If Me.cboCur.Enabled = True Then If Trim(Me.cboCur.Value) = "Choose Cur" Then Me.cboCur.SetFocus MsgBox "Please choose cur" exit sub '***************************************** Else If Me.cboCur.Enabled = False Then GoTo Final End If End If Exit Sub End If
2. Prøv at lave nedstående:
With ws .Cells(iRow, 4).Value = Me.cboFac.Value .Cells(iRow, 5).Value = Me.cboCur.Value .Cells(iRow, 6).Value = Me.txtMax.Value .Cells(iRow, 7).Value = Me.txtAct.Value .Cells(iRow, 14).Value = Me.txtComments.Value End With
Om til:
With ws .Cells(iRow, 4) = Me.cboFac .Cells(iRow, 5) = Me.cboCur .Cells(iRow, 6) = Me.txtMax .Cells(iRow, 7) = Me.txtAct .Cells(iRow, 14) = Me.txtComments End With
1 - Den exit sub kan jeg ikke indsætte, da det er betinget at man skal vælge noget i comboboksen ellers kommer man ikke videre. Derfor er der intet exit sub som du angiver, samt jeg skal have den til at køre videre i min kode ellers kommer den ikke ned i den nsæte if-sætning.
2 - Har prøvet, men det gav ingen effekt.
Nu har jeg fået min cbofac op at køre, men min enterkanp kan jeg ikke få til at kontrollere om der er angivet en værdi eller ej. Jeg tror problemet ligger i den "tomme" celleværdi, fordi den vil gerne kontrollere i de andre bokse hvor der er angivet en tekst.
Nu har jeg fundet ud af det... Du har selvfølgelig ret hvad angår den exit sub.. Den skal være der. Den anden ting er jeg fandt ud af gjorde en forskel var den sidste exit sub. Den havde jeg placeret forkert.
Forkert: If Me.txtActual.Enabled = True Then If Trim(Me.txtActual.Value) = "" Then Me.txtActual.SetFocus MsgBox "Please enter outstanding amount" ElseIf Me.txtActual.Enabled = False Then GoTo Final2 End If Exit Sub End If Final2:
Den rigtige:
If Me.txtActual.Enabled = True Then If Trim(Me.txtActual.Value) = "" Then Me.txtActual.SetFocus MsgBox "Please enter outstanding amount" Exit Sub*********************************** Og denne er kommet ind. ElseIf Me.txtActual.Enabled = False Then GoTo Final2 Exit Sub ************************************ Er flyttet et takt op. End If End If Final2:
Den hang jo i den der IF lykke så den kom jo ikke videre...
Jeg har jo det her nummer ud for hver række. Så hvis man vælger nummer 1 som står i række 4 så skal den indsætte de oplysninger fra række 4/nummer 1 som kommer fra de dertil hørende comboboxe og textboxe fra userformen. Den skal søge i excel arket op til de der 500 nummere som også blev angivet i nummerkoden. Jeg har fået opsat en ja/nej formel, jeg mangler bare at få udfyldt ja-siden.
Din nummertæller opfører sig underlig igen.. Jeg slettede nogle at de rækker jeg havde og da jeg kom ned til den sidste række med nummer 1 i række 4 sagde den mismatch igen. Den tæller I til at være = 501.. Hvorfor gør den nu det??
Private Function Number() Dim NewData(500) As Variant, Data As Variant, I As Integer
Data = Sheets("Rapport - under udvikling").Range(Range("A4"), Sheets("Rapport - under udvikling").Range("A65536").End(xlUp))********** Range A4 = 1 For I = 1 To 500*************** Her er I = 501, hvorfor????? NewData(I) = I Next
If Sheets("Rapport - under udvikling").Range("A65536").End(xlUp).Row >= 4 Then
For I = 1 To UBound(Data)************ Hvilket så skaber problemer her... NewData(Data(I, 1)) = Empty Next End If Number = WorksheetFunction.Min(NewData) Me.Number1.Font.Bold = True End Function
Private Function Number() Dim NewData(500) As Variant, Data As Variant, I As Integer
Data = Sheets("Rapport - under udvikling").Range(Range("A4"), Sheets("Rapport - under udvikling").Range("A65536").End(xlUp)) '********** Range A4 = 1 For I = 1 To 500 '*************** Her er I = 501, hvorfor????? NewData(I) = I Next
If Sheets("Rapport - under udvikling").Range("A65536").End(xlUp).Row >= 4 Then
For I = 1 To UBound(Data) '************ Hvilket så skaber problemer her... NewData(Data(I, 1)) = Empty Next End If Number = WorksheetFunction.Min(NewData) End Function
Functionen virker fint her, jeg har fjernet en linje.
Me.Number1.Font.Bold = True
Det er ikke godt at ligge denne linje ind i en function, sæt den ind i subben lige efter functions kaldet
Den virkede også fint, men jeg har i min sletfunktion sat den til at opdatere i userform så den viser det nyeste ledige nummer.. Men selvom jeg slået alt fra så kan jeg ikke få den til at køre igen.. Kan det have noget at gøre med at selve arket er er sat som om der er tomme linier efter række 500. Jeg har lagt en farve henover hele arket og så har jeg markeret de rækker og kolonner op som skal bruges.
Hej Kabbak, super fin løsning du fik lavet. Men jeg har overvejet om det ikke er bedre jeg bruger en inputbox i min Renew knap efter man har valgt et nummer. Denne inputbox skal så komme op med de data der er til de 9 txtboxe - ændre i dataene og så gemme dem igen under samme nummer..
For ellers er der jo det problem med de der comcoboxe som du også selv nævnte. Hvad synes du om den ide??
En sidste ting er at når jeg trykker på renew og der kun er en række udfyldt så kommer den op med en fejlmeddelse a la den der kom under autonummer..
Jeg har lavet det sådan at hvis man vil ændre i de felter hvor man skal bruger en combobox når man indtaster data så skal man slettet rækken og starte forfra. Det er fordi at hvis man ændre i disse data så kan man ligeså godt starte forfra.
Så de comboboxe er røget ud under renew knappen.
Nu skal jeg bare have den til at genkende den rigtige række igen, så dataene kan komme tilbage i den rigtige række..
jeg kan fortælle dig at nu køre det efterhånden som det skal. Jeg har dog lige nogle små ting der driller og jeg håber du kan hjælpe med det..
1) I den ene txtbox skal jeg have % tal.. Jeg har indsat følgende kode for at styre input i txtboxen.
Private Sub txtActInt_Exit(ByVal Cancel As MSForms.ReturnBoolean) On Error Resume Next Me.txtActInt.ControlTipText = "5% - write 5 and it will be converted to 0,05" Me.txtActInt.Value = ((Me.txtActInt.Value) / 100) With Me.txtActInt If Not IsNumeric(.Text) Or Len(.Text) > 5 Then MsgBox "Actual Interest has invalid characters or wrong number of numerical digits in field. " _ & "Enter only numbers with no dashes." 'Cancel = True .SetFocus .SelStart = 0 .SelLength = Len(.Text) End If End With End Sub
For 5% så skriver jeg 5 bliver det til 0,05 i txtboxen og i excel er det 5%. Kan det laves på en anden måde??
2) For de første 12 dage bytter den rundt på dd-mm-yy til mm-dd-yy kan dette ændres så det bliver til dd-mm-yy også for de første 12 dage?
3) Som du kan se bruger jeg "On Error Resume Next", hvilket jeg har fundet ud af hjælper mig af med mange bugs. F.eks hvis jeg trykkede 0 i dato så brokkende den sig.. Det gør den ikke længere, nu opdager brugeren ikke der er en fejl. Bruger du denne funktion eller andre som er ligeså gode??
3) Hvordan får jeg beskyttet arket og koden i VB så godt at det ikke er muligt for en bruger at ændre i arket eller i koden på programmet? Arket skal beskyttes så man ikke kan foretage manueller inputs..
1. Private Sub txtActInt_Exit(ByVal Cancel As MSForms.ReturnBoolean) On Error Resume Next Me.txtActInt.ControlTipText = "5% - write 5 and it will be converted to 0,05" With Me.txtActInt If Not IsNumeric(.Text) Or Len(.Text) > 5 Then MsgBox "Actual Interest has invalid characters or wrong number of numerical digits in field. " _ & "Enter only numbers with no dashes." 'Cancel = True .SetFocus .SelStart = 0 .SelLength = Len(.Text) End If End With Me.txtActInt.Value = Format(((Me.txtActInt.Value) / 100), "##%") End Sub
3. ok, jeg bruger den også
4. du kan sætte password på begge, når så din kode skal skrive i arket, låser du den op via kode og låser den igen når den er færdig
1) I procent har jeg sagt #.##% ellers kommer decimalerne ikke med.. Men hvis jeg skriver bare 5 så overfører den 5,% hvordan får jeg det ændret så den skriver 5% eller 5,0%??
2)I min dato funktion bruger den også Datevalue(Txtbox) og den skriver i formatet 01-03-05 men den bytter alligevel om på de første 12 dage med måned. Koden er:
Private Sub txtDate_Exit(ByVal Cancel As MSForms.ReturnBoolean) Dim newsecond As Variant txtDate = Format(CheckDate(txtDate.Text), "dd-mm-yy") If Me.txtDate.Text = "30-12-99" Then Me.txtDate.Text = "dd-mm-yy" If Me.txtDate.Text <> "dd-mm-yy" And Me.cboName.Value <> "Choose Company/Region" Then With Me .CmdbEnterData.Enabled = True .Cmdbdelete.Enabled = True .CmdbRenew.Enabled = True .txtBank.Enabled = True .lblBank.Enabled = True .cboFac.Enabled = True .lblFacility.Enabled = True .cboCode.Enabled = True .lblCompanyCode.Enabled = True End With Else With Me .CmdbEnterData.Enabled = False .Cmdbdelete.Enabled = False .CmdbRenew.Enabled = False .txtBank.Enabled = False .lblBank.Enabled = False .cboFac.Enabled = False .lblFacility.Enabled = False .cboCode.Enabled = False .lblCompanyCode.Enabled = False End With End If End Sub
Private Function CheckDate(TDate As String) As Date Worksheets("Rapport - under udvikling").Unprotect On Error Resume Next Select Case Len(TDate) Case 4 CheckDate = Format(DateValue(Mid(TDate, 1, 2) & "-" & Mid(TDate, 3, 2) & "-" & Year(Date)), "dd-mm-yy") Case 6 CheckDate = Format(DateValue(Mid(TDate, 1, 2) & "-" & Mid(TDate, 3, 2) & "-" & Mid(TDate, 5, 2)), "dd-mm-yy") Case 8 CheckDate = Format(DateValue(Mid(TDate, 1, 2) & "-" & Mid(TDate, 3, 2) & "-" & Mid(TDate, 7, 2)), "dd-mm-yy") Case Else End Select If UCase(TDate) = "dd" Then CheckDate = Format(Date, "dd-mm-yy") Worksheets("Rapport - under udvikling").Protect End Function
1. "I procent har jeg sagt #.##% ellers kommer decimalerne ikke med.. Men hvis jeg skriver bare 5 så overfører den 5,% hvordan får jeg det ændret så den skriver 5% eller 5,0%??"
prøv med "0.0%" 2.
Prøv at teste med denne function
Private Function CheckDate(TDate As String) As Date Worksheets("Rapport - under udvikling").Unprotect On Error Resume Next Select Case Len(TDate) Case 4 CheckDate = Format(DateSerial(Year(Date), Mid(TDate, 3, 2), Mid(TDate, 1, 2)), "dd-mm-yy") Case 6 CheckDate = Format(DateSerial(Mid(TDate, 5, 2), Mid(TDate, 3, 2), Mid(TDate, 1, 2)), "dd-mm-yy") Case 8 CheckDate = Format(DateSerial(Mid(TDate, 7, 2), Mid(TDate, 3, 2), Mid(TDate, 1, 2)), "dd-mm-yy") Case Else End Select If UCase(TDate) = "dd" Then CheckDate = Format(Date, "dd-mm-yy") Worksheets("Rapport - under udvikling").Protect End Function
Den bytter stadig rundt på de første 12 dage, hvis jeg har formateret cellen i excel til et dato felt. Men bruger jeg et textfelt er der ingen problemer.. Hvad skyldes dette??
Ved procent vil jeg gerne have 4 decimaler.. Den virker fint med "0.00%" ved to decimaler.. Hvordan får jeg 4 decimaler??
Har prøvet "0,0000%" så får jeg 50% til at være 50000% osv.
Det jeg mente var at hvis jeg formaterede cellen 1,4 til dato så bytter den rundt, men er det en text celle så køre koden fint igennem din funktion. Hvad skyldes dette??
Kabbak, jeg har fået løst mine problemer med % og med dato rokeringen mellem dd og mm. En betingelse for at bruge funktionen til dato og for at kunne bruge "0.0###%" er at cellerne i excel skal være i format "text" ellers giver det problemer.
Men jeg har stadig et lille problem med auto nummer. Det drejer sig om den første række i række 4, den får nummeret 1, men autonummer tæller først fra række 5, så 1 går igen i række 5 når jeg indsætter en ny række. Det går ikke...
Private Function Number() Dim NewData(500) As Variant, Data As Variant, I As Integer
Data = Sheets("BOverview").Range(Range("A4"), Sheets("BOverview").Range("A65536").End(xlUp)) For I = 1 To 500 NewData(I) = I Next
If Sheets("BOverview").Range("A65536").End(xlUp).Row >= 5 Then
For I = 1 To UBound(Data) NewData(Data(I, 1)) = Empty Next End If Number = WorksheetFunction.Min(NewData) End Function
Samme problem har jeg når jeg skal forny en række, så kan den ikke finde den første række hvis der kun er en række i arket.
Her er et uddrag af koden til forny en rækkes data.
Select Case I Case vbOK iCopy = Val(InputBox("Insert number.")) If iCopy = 0 Then MsgBox ("No account was chosen") Me.cboCode.SetFocus Exit Sub Else RW = Sheets("BOverview").Range("A4:A" & Sheets("BOverview").Range("A65536").End(xlUp).Row)
If Sheets("BOverview").Range("A65536").End(xlUp).Row >= 5 Then For Y = 1 To UBound(RW) If RW(Y, 1) = iCopy Then iRow = Y + 3 Exit For End If Next End If If iCopy > iRow Then Exit Sub ElseIf iCopy <= iRow Then
Private Function Number() Dim NewData(500) As Variant, Data As Variant, I As Integer If Sheets("Bank Overview").Range("A65536").End(xlUp).Row < 4 Then Number = 1 Exit Function End If Data = Sheets("Bank Overview").Range(Range("A4"), Sheets("Bank Overview").Range("A65536").End(xlUp)) For I = 1 To 500 NewData(I) = I Next If Sheets("Bank Overview").Range("A65536").End(xlUp).Row >= 5 Then For I = 1 To UBound(Data) NewData(Data(I, 1)) = Empty Next Else NewData(Data) = Empty End If Number = WorksheetFunction.Min(NewData) End Function
If Sheets("Bank Overview").Range("A65536").End(xlUp).Row >= 5 Then For Y = 1 To UBound(RW) If RW(Y, 1) = Me.Number2.Caption Then iRow = Y + 3 Exit For End If Next Else ' NY iRow = 4' NY End If
Den i renew er ikke god, da den så altid vil komme frem med den første række hvis man indtaster forkert nummer eller nummer der ikke findes..
Men hvis du lige har en løsning på dette, så er det super, ellers acceptere jeg det du har lavet samt været med til at videre udvikle mit eget kodesprog.
If Sheets("Bank Overview").Range("A65536").End(xlUp).Row >= 5 Then For Y = 1 To UBound(RW) If RW(Y, 1) = Me.Number2.Caption Then iRow = Y + 3 Exit For End If Next Else ' NY If Range("A4") = Me.Number2.Caption Then ' NY iRow = Y + 3 Exit For End If End If
If Sheets("Bank Overview").Range("A65536").End(xlUp).Row >= 5 Then For Y = 1 To UBound(RW) If RW(Y, 1) = Me.Number2.Caption Then iRow = Y + 3 Exit For End If Next Else ' NY If Range("A4") = Me.Number2.Caption Then ' NY iRow = 4 Exit For End If End If
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
