30. september 2012 - 00:44Der er
5 kommentarer og 1 løsning
Start makro fra cmd button og få listbox ind i macro
Jeg har nedenstående CMD button som skal starte makroen DeleteBlankARows() (den virker hvis jeg starter den som macro direkte fra det pågældende ark, dog med den motifikation at jeg vælger "FORD" istedet for listbox2) , men ved ikke hvordan det skal gøres, samtidig har jeg listbox2 hvor jeg vælger nogle bilmærker, som skal slettes, hvad skal kommandoen være i If cells.....?
Private Sub CommandButton3_Click()
' Sub DeleteBlankARows()
With Application .Calculation = xlCalculationManual .ScreenUpdating = False Dim r As Long For r = Cells(Rows.Count, 11).End(xlUp).Row To 1 Step -1 If Cells(r, 11) = ListBox2.Value Then Rows(r).Delete Next r .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With
Rem VBA-koden er indsat i en Userform: Rem ListBox1 er anvendt i stedet for ..2
Sub DeleteBlankARows() With Application .Calculation = xlCalculationManual .ScreenUpdating = False
Dim r As Long For r = Cells(Rows.Count, 11).End(xlUp).Row To 1 Step -1 If Cells(r, 11) = ListBox1.Value Then Rows(r).Delete End If Next r .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With
End Sub Private Sub CommandButton1_Click() DeleteBlankARows End Sub Private Sub UserForm_activate() 'Opbygning af test-data Me.ListBox1.AddItem "AAA" Me.ListBox1.AddItem "BBB" Me.ListBox1.AddItem "CCC" Me.ListBox1.AddItem "DDD" End Sub
Jeg ville have vedhæftet en kopi af useform, men ved ikke hvordan jeg kan vedhæfte word dokument?
Når jeg markere flere felter og flytter dem fra Listbox1 til listbox2, så sletter kun hvis listbox 2 har en værdi, hvis listbox2 har flere værdier, så sker der ikke noget, kan det også løses?
Private Sub UserForm_Initialize()
Sheets("Ark2").Select
End Sub Private Sub UserForm_activate() 'Opbygning af test-data
Sub DeleteBlankARows() With Application .Calculation = xlCalculationManual .ScreenUpdating = False
Dim r As Long For r = Cells(Rows.Count, 10).End(xlUp).Row To 1 Step -1 If Cells(r, 10) = ListBox1.Value Then Rows(r).Delete End If Next r .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With
End Sub Private Sub CommandButton3_Click()
DeleteBlankARows
End Sub
Private Sub CommandButton1_Click()
For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) = True Then ListBox2.AddItem ListBox1.List(i) Next i
End Sub
Private Sub CommandButton2_Click()
Dim counter As Integer counter = 0
For i = 0 To ListBox2.ListCount - 1 If ListBox2.Selected(i - counter) Then ListBox2.RemoveItem (i - counter) counter = counter + 1 End If Next i
CheckBox2.Value = False
End Sub
Private Sub OptionButton3_Click()
ListBox1.MultiSelect = 2 ListBox2.MultiSelect = 2
End Sub
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then For i = 0 To ListBox1.ListCount - 1 ListBox1.Selected(i) = True Next i End If
If CheckBox1.Value = False Then For i = 0 To ListBox1.ListCount - 1 ListBox1.Selected(i) = False Next i End If
End Sub
Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then For i = 0 To ListBox2.ListCount - 1 ListBox2.Selected(i) = True Next i End If
If CheckBox2.Value = False Then For i = 0 To ListBox2.ListCount - 1 ListBox2.Selected(i) = False Next i End If
PS: Anvend venligst KOMMENTAR når du svarer. SVAR anvendes af forslagsstiller når et indlæg forventes af kunne løse det stillede problem. Et SVAR kan så blive ACCEPTERET eller AFVIST af opgavestiller.
Har tilføjet en funktion, der anvendes i DeleteBlankARows
Sub DeleteBlankARows() With Application .Calculation = xlCalculationManual .ScreenUpdating = False
Dim r As Long For r = Cells(Rows.Count, 10).End(xlUp).Row To 1 Step -1 If erDetListeVærdi(Cells(r, 10)) = True Then Rows(r).Delete End If Next r .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub Private Function erDetListeVærdi(xlsVærdi) For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) = True _ And ListBox1.List(i) = xlsVærdi Then erDetListeVærdi = True Exit Function End If Next i erDetListeVærdi = False End Function
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.