Listbox problemmer
Jeg har en listbox som er inbygget i arket dvs.ikke på formen. Brugeren vælger et emne ad gangen og så kører makro som kopirer nogen række til arket. Men en gang imellem sker det computer når man klikker på et emne i listen opfatter som om man har klikket flere gange på emnet. Jeg troede at der var noget galt med min mus men det sker også på andre computere dog kun en gang imellem. Makroen kører ellers godt. Hvad kan jeg gøre?Her er koden:
Private Sub ListBox1_Click()
Dim rFound As Range
Dim rLook As Range
Dim rValue As String
Dim rDest As Range
rValue = ListBox1.Value
Set rLook = Worksheets("Axe").Range("c2:aw2")
Set rFound = rLook.Find(rValue, , , xlWhole)
If Not rFound Is Nothing Then
rFound.Resize(44, 1).Copy
With Worksheets("Ark1")
With .Range("IV29").End(xlToLeft).Offset(0, 1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteComments
Selection.HorizontalAlignment = xlCenter
End With
End With
End If
Set rLook = Worksheets("Dax").Range("c2:aw2")
Set rFound = rLook.Find(rValue, , , xlWhole)
If Not rFound Is Nothing Then
rFound.Resize(44, 1).Copy
With Worksheets("Ark1")
With .Range("IV29").End(xlToLeft).Offset(0, 1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteComments
Selection.HorizontalAlignment = xlCenter
End With
End With
End If
Set rLook = Worksheets("Rix").Range("c2:aw2")
Set rFound = rLook.Find(rValue, , , xlWhole)
If Not rFound Is Nothing Then
rFound.Resize(44, 1).Copy
With Worksheets("Ark1")
With .Range("IV29").End(xlToLeft).Offset(0, 1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteComments
Selection.HorizontalAlignment = xlCenter
End With
End With
End If
Set rLook = Worksheets("Vix").Range("c2:aw2")
Set rFound = rLook.Find(rValue, , , xlWhole)
If Not rFound Is Nothing Then
rFound.Resize(44, 1).Copy
With Worksheets("Ark1")
With .Range("IV29").End(xlToLeft).Offset(0, 1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteComments
Selection.HorizontalAlignment = xlCenter
End With
End With
End If
End Sub
