Fehlersuche
08.08.2014 09:29:52
Nik
ich habe folgendes Programmiert:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim RaBereich As Range
Set RaBereich = Range("BB2:BK1000000")
If Not Intersect(Target, RaBereich) Is Nothing Then
If Target.Borders(xlDiagonalDown).LineStyle = 1 Then
With Target
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
Else
With Target
.Borders(xlDiagonalDown).LineStyle = xlContinuous
.Borders(xlDiagonalDown).Weight = xlThick
.Borders(xlDiagonalUp).LineStyle = xlContinuous
.Borders(xlDiagonalUp).Weight = xlThick
End With
End If
Cancel = True
End If
Set RaBereich = Nothing
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws2 As Worksheet
Dim aktZeile As Long
Set ws2 = ThisWorkbook.Worksheets("Messauftrag")
If Target.Rows.Count > 1 Then Exit Sub
aktZeile = Target.Row
ws2.Range("B5") = Me.Cells(aktZeile, "B")
ws2.Range("B6") = Me.Cells(aktZeile, "C")
ws2.Range("B7") = Me.Cells(aktZeile, "F")
ws2.Range("B8") = Me.Cells(aktZeile, "G")
ws2.Range("B9") = Me.Cells(aktZeile, "AP")
ws2.Range("B10") = Me.Cells(aktZeile, "K")
ws2.Range("B11") = Me.Cells(aktZeile, "AM")
ws2.Range("E5") = Me.Cells(aktZeile, "I")
ws2.Range("E6") = Me.Cells(aktZeile, "J")
ws2.Range("E7") = Me.Cells(aktZeile, "BM")
ws2.Range("E8") = Me.Cells(aktZeile, "BN")
ws2.Range("E9") = Me.Cells(aktZeile, "BO")
ws2.Range("B16") = Me.Cells(aktZeile, "AQ")
ws2.Range("B17") = Me.Cells(aktZeile, "N")
ws2.Range("B18") = Me.Cells(aktZeile, "AN")
ws2.Range("B19") = Me.Cells(aktZeile, "AF")
ws2.Range("B20") = Me.Cells(aktZeile, "AJ")
ws2.Range("B21") = Me.Cells(aktZeile, "AC")
ws2.Range("B22") = Me.Cells(aktZeile, "AG")
ws2.Range("B23") = Me.Cells(aktZeile, "AB")
ws2.Range("B24") = Me.Cells(aktZeile, "AD")
ws2.Range("B25") = Me.Cells(aktZeile, "AE")
ws2.Range("B26") = Me.Cells(aktZeile, "AI")
ws2.Range("B27") = Me.Cells(aktZeile, "R")
ws2.Range("E16") = Me.Cells(aktZeile, "S")
ws2.Range("E17") = Me.Cells(aktZeile, "T")
ws2.Range("E18") = Me.Cells(aktZeile, "U")
ws2.Range("E19") = Me.Cells(aktZeile, "W")
ws2.Range("E20") = Me.Cells(aktZeile, "Y")
ws2.Range("E21") = Me.Cells(aktZeile, "V")
ws2.Range("E22") = Me.Cells(aktZeile, "X")
ws2.Range("E23") = Me.Cells(aktZeile, "Z")
ws2.Range("E24") = Me.Cells(aktZeile, "AA")
ws2.Range("B32") = Me.Cells(aktZeile, "BB")
ws2.Range("B33") = Me.Cells(aktZeile, "BC")
ws2.Range("B34") = Me.Cells(aktZeile, "BD")
ws2.Range("B35") = Me.Cells(aktZeile, "BE")
ws2.Range("B36") = Me.Cells(aktZeile, "BF")
ws2.Range("B37") = Me.Cells(aktZeile, "BG")
ws2.Range("B38") = Me.Cells(aktZeile, "BH")
ws2.Range("B39") = Me.Cells(aktZeile, "BI")
ws2.Range("B40") = Me.Cells(aktZeile, "BJ")
ws2.Range("B41") = Me.Cells(aktZeile, "BK")
ws2.Range("E32") = Me.Cells(aktZeile, "AR")
ws2.Range("E33") = Me.Cells(aktZeile, "AS")
ws2.Range("E34") = Me.Cells(aktZeile, "AT")
ws2.Range("E35") = Me.Cells(aktZeile, "AU")
ws2.Range("E36") = Me.Cells(aktZeile, "AV")
ws2.Range("E37") = Me.Cells(aktZeile, "AW")
ws2.Range("E38") = Me.Cells(aktZeile, "AX")
ws2.Range("E39") = Me.Cells(aktZeile, "AY")
ws2.Range("E40") = Me.Cells(aktZeile, "AZ")
ws2.Range("E41") = Me.Cells(aktZeile, "BA")
End Sub
Ich habe 2 Reiter, auf dem ersten ist eine Tabelle, in der unter anderem "Kreuze" gesetzt werden können. Diese "Kreuze" sollen in den 2.Reiter übertragen werden. Allerdings verstehe ich nicht genau wie ich das programmieren soll... Momentan bin ich so weit, dass man im 1.Reiter die Kreuze setzen kann durch Doppelklick. Jetzt sollen diese aber in den 2.Reiter in B32-B41 übertragen werden. Und außerdem sollen die Kreuze im 2.Reiter auch aktualisiert werden, je nachdem welche Zeile im 1.Reiter angeklickt ist.