En förbättring jag har jobbat på senaste veckorna är följande: jag har lagt till en ”flersides”-formulär.. Pa varje sida finnes mellan 4 – 6 stycken Kryssrutor (CheckBox) med korresponderande textruta (TextBox).
Jag försöker få ”programmet” att göra följande:
Arbetsboken består av 10 sidor med “vätskebalans” som den aktiva, som öppnas då arbetsboken öppnas.
När boken öppnas visas endast sidan ”vätskebalans”.
När knappen ”vbl” trycks visas formuläret i egen ruta.
Då man tycker på en knapp på en sida skall följande hända:
Kolla vilka av kryssrutorna är markerade
Kolla efter den första ifyllda rutan i området E7:K7
Sök i området B15:B36 efter ”checkbox..Caption”
om ”checkbox..Caption” hittats så förflytta - på den rad där uttrycket hittats –till den kolumn i området E7:K7 där den första tomma cellen hittats och där fylla i ”TextBox.Value”
om ej ”checkbox..Caption” hittats så skriv in detta i första tomma cellen i området B15:B36 och förflytta till den kolumn i området E7:K7 där den första tomma cellen hittats och där fylla i ”TextBox.Value”.
Upprepa detta tills samtliga kryssrutor och textrutor…
Följande kod har jag kommit fram till senaste veckan:<font size="1" face="Verdana, Arial, Helvetica, sans-serif">Kod:<font size="1" face="Verdana, Arial, Helvetica, sans-serif" color="#666600">. Private Sub Search_fill()
Dim wsBlad As Worksheet
Dim m As Range
Dim p As Range
Dim q As Range
Dim r As Range
Dim ctr As MSForms.Control
Dim txb As MSForms.Control
Set wsBlad = ThisWorkbook.Worksheets("vätskebalans")
Set mysearch = ctr.Caption
Set r = Application.WorksheetFunction.CountA(Range("E7:K7")) + 1
Set p=wsBlad.Range(”B15:B36”)
Set q= Application.WorksheetFunction.CountA(Range(”B15:B36”)) + 1
For Each ctr In MultiPage1.Pages(MultiPage1.Value).Controls
If TypeOf ctr Is MSForms.CheckBox Then
If ctr.Value true then
With p
Set m =.Find(What:=mysearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If m is nothing then
Cells(q,0).Value=mysearch
Cells(0,r).Value=txb.Value
Else Cells (0,r).Value= txb.Value
End If
End If
End if
End with
Next ctr
End Sub
Problemet är att när jag trycker F5 i VBE får jag bara felmeddelande
Taxam för hjälp med koden
------------------
Tack på förhand!
Det är svårt när förmågan/kunskaperna vida överstiger idéerna/Peter
Hej Dennis,
Hoppas Du har haft en bra sommar!.
”Dags” har hela tiden varit, har bara ägnat tiden åt att läsa boken, och försöka på egen hand. Jag köpte John Walkenbach :”XL2000 power programming with VBA”
Har lärt mig massor, men det är inte så lätt bara på egen hand….
Debugging och msgbox är en av sakerna som jag inte riktigt fattat – menar Du att jag bör sätta ett msgbox efter varje set?
r - range?
q - range??
Det var ju Du som lärde mig att definiera sådana områden som Range
/Peter
------------------
Tack på förhand!
Det är svårt när förmågan/kunskaperna vida överstiger idéerna/Peter
Är detta upplägg bättre, kanske tom bra??<font size="1" face="Verdana, Arial, Helvetica, sans-serif">Kod:<font size="1" face="Verdana, Arial, Helvetica, sans-serif" color="#666600">Private Sub Search_fill()
Dim wsBlad As Worksheet
Dim mysearch as String
Dim Datum As Range
Dim Sort As Range
Dim m As String
Dim rnCellD As Range
Dim ctr As MSForms.Control
Dim txb As MSForms.Control
Set wsBlad = ThisWorkbook.Worksheets("vätskebalans")
Set mysearch = ctr.Caption
Set Datum = wsBlad.Range("E7:K7")
For Each rnCellD In Datum
If Not IsEmpty(rnCellD) Then
Set Sort = Range(rnCellD.Offset(8, -3), rnCellD.Offset(42, -3))
For Each ctr In MultiPage1.Pages(MultiPage1.Value).Controls
If TypeOf ctr Is MSForms.CheckBox Then
If ctr.Value = true then
With Sort
Set m =.Find(What:=mysearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If m is nothing then
Cells(sort,1).Value=mysearch
Cells(1, rnCellD).Value=txb.Value
Else Cells(1, rnCellD).Value=txb.Value
End If
End If
End if
End with
Next ctr
Next rnCellD
End Sub
------------------
Tack på förhand!
Det är svårt när förmågan/kunskaperna vida överstiger idéerna/Peter
Dennis,
Jag försökte ikväll:
I projekt5.xls/formulär –mappen/UserForm1 satte jag in nedanstående:<font size="1" face="Verdana, Arial, Helvetica, sans-serif">Kod:<font size="1" face="Verdana, Arial, Helvetica, sans-serif" color="#666600"> Private Sub Search_fill()
Dim wsBlad As Worksheet
Dim mysearch As String
Dim Datum As Range
Dim Sort As Range
Dim m As String
Dim rnCellD As Range
Dim ctr As MSForms.Control
Dim txb As MSForms.Control
Set wsBlad = ThisWorkbook.Worksheets("vätskebalans")
Set mysearch = ctr.Caption
Set Datum = wsBlad.Range("E7:K7")
For Each rnCellD In Datum
If Not IsEmpty(rnCellD) Then
Set Sort = Range(rnCellD.Offset(8, -3), rnCellD.Offset(42, -3))
For Each rnCellD In Sort
MsgBox rnCellD.Adress
Next rnCellD
For Each ctr In MultiPage1.Pages(MultiPage1.Value).Controls
If TypeOf ctr Is MSForms.CheckBox Then
If ctr.Value = True Then
With Sort
Set m = .Find(What:=mysearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If m Is Nothing Then
MsgBox Cells(Sort, 1).Address
Cells(Sort, 1).Value = mysearch
Cells(1, rnCellD).Value = txb.Value
Else: Cells(1, rnCellD).Value = txb.Value
End If
End If
End If
End With
Next ctr
Next rnCellD
End Sub
Private Sub CommandButton1_Click()
Search_fillEnd Sub
När jag Tryckte F5 fick jag felmeddelandet: Kompileringsfel: objekt krävs och mysearch (i Set mysearch = ctr.Caption) blev markerad. När jag sedan klickar på ok blir helaraden: ” Private Sub Search_fill()” överstruken med gul-penna. Så jag kan inte ens prova ”addresserna”
Vad gör jag för FEL???
/Peter
------------------
Tack på förhand!
Det är svårt när förmågan/kunskaperna vida överstiger idéerna/Peter
klart bättre - dessutom har jag redan själv kommit på det...
MEN: nu bråkar msgboxalternativet<font size="1" face="Verdana, Arial, Helvetica, sans-serif">Kod:<font size="1" face="Verdana, Arial, Helvetica, sans-serif" color="#666600">For Each rnCellD In Datum
If Not IsEmpty(rnCellD) Then
Set Sort = Range(rnCellD.Offset(8, -3), rnCellD.Offset(42, -3))
For Each rnCellD In Sort
MsgBox rnCellD.Adress
Next rnCellD Jag får hella tiden error:For används redanFor Each rnCellD In Sort
iof kommer formuläret upp, men jag kan ej fortsätta testandet
------------------
Tack på förhand!
Det är svårt när förmågan/kunskaperna vida överstiger idéerna/Peter
Hej Peter & Dennis
Det är sådana här inlägg som gör att det är värt att logga in då och då.
Bra exempel och öppen dialog.
Kunde man tänka sig att Peter la ut det färdiga resultatet som grädde på Moset??
Dennis,
jag är ledsen, det var inte alls meningen att förolämpa dig!! Är mycket tacksam för all övärderligt hjälp fr dig!!
Dessutom VET jag att du även finns på EXCEL-L . Min tanke var mera att se vartifrån jag får snabbare svar. Men som sagt om jag förolämpade dig på ngt sätt så ber jag om ursäkt!!
------------------
Tack på förhand!
Det är svårt när förmågan/kunskaperna vida överstiger idéerna/Peter
