Kommentare verschieben

[MuMa0806]

Ich habe alles genauso gemacht, bekomme dennoch einen "Laufzeitfehler '1004' Anwendungs- und objektdefinierter Fehler".


For Each it In Intersect(Selection.EntireRow, Range("J6:ON14")).SpecialCells(-4144)
    If Intersect(it.Offset(y), Intersect(Selection.EntireRow, Range("J6:ON14")).SpecialCells(-4144)) Is Nothing Then it.Offset(y).AddComment
    c00 = it.Offset(y).Comment.Text
    it.Offset(y).Comment.Text it.Comment.Text
    If c00 <> "" Then it.Comment.Text c00
  Next

Der unterstrichene Part wird mir dann nach dem debuggen angezeigt...

Mach ich vielleicht was verkehrt?

[snb]

Hast du den Code in der angehängte Datei getestet ?
Die 'ActiveCell' sol in eine Zeile mit Zellen mit Comments stehen.
Ich kann nicht sehen welche Wert Variabele 'y' hat.

Ich sehe überhaupt nicht in welcher Datei du arbeitest.

[schauan]

... Bist Du jetzt vielleicht in Zeile 1 gewesen?

[MuMa0806]

Ich habe den Code an einen Spinbutton angepasst, und zwar wie folgt:

Code:

Sub M_snb(y As Integer)

  For Each it In Intersect(Selection.EntireRow, Range("L6:ON15")).SpecialCells(-4144)
    If Intersect(it.Offset(y), Intersect(Selection.EntireRow, Range("L6:ON15")).SpecialCells(-4144)) Is Nothing Then it.Offset(y).AddComment
    c00 = it.Offset(y).Comment.Text
    it.Offset(y).Comment.Text it.Comment.Text
    If c00 <> "" Then it.Comment.Text c00
  Next
 
End Sub

Code:

Private Sub SpinButton1_SpinDown()

M_snb (1)

End Sub

Private Sub SpinButton1_SpinUp()

M_snb (-1)

End Sub

Ich habe im Zellbereich L6:ON15 gearbeitet.

Ich füge meine Datei einfach nochmal mit ein.

Viele Grüße!!!

[snb]

Code:

Sub M_snb(y As Integer)
  For Each it In Intersect(Selection.EntireRow, Range("L6:ON15")).SpecialCells(-4144)
    If Intersect(it.Offset(y), Range("L6:ON15")).SpecialCells(-4144) Is Nothing Then it.Offset(y).AddComment

    c00 = it.Offset(y).Comment.Text
    it.Offset(y).Comment.Text it.Comment.Text
    If c00 <> "" Then it.Comment.Text c00
  Next
End Sub

Lösche alle verbundene Zellen !

[Kuwer]

Hallo Marcel,

Du kannst es ja auch mal damit testen:

Code:

Sub KommentareTauschen(lngZ As Long)
  Dim oWsA As Worksheet
  Dim oWsT As Worksheet
  Dim rngA As Range
  ActiveCell.Activate
  If ActiveCell.Row > 5 And lngZ + ActiveCell.Row > 5 Then
    Application.ScreenUpdating = False
    Set oWsA = ActiveSheet
    Set rngA = Intersect(ActiveCell.EntireRow, Range("H:ON"))
    Set oWsT = Workbooks.Add(-4167).Worksheets(1)
    rngA.Copy oWsT.Cells(1, 1)
    rngA.ClearComments
    rngA.Offset(lngZ).Copy oWsT.Cells(2, 1)
    rngA.Offset(lngZ).ClearComments
    oWsT.Cells(1, 1).Resize(, rngA.Columns.Count).Copy
    rngA.Offset(lngZ).PasteSpecial Paste:=xlPasteComments
    oWsT.Cells(2, 1).Resize(, rngA.Columns.Count).Copy
    rngA.Offset(0).PasteSpecial Paste:=xlPasteComments
    Application.CutCopyMode = False
    oWsT.Parent.Close False
    ActiveCell.Select
    Application.ScreenUpdating = True
  End If
End Sub

  Dienstplan_Kommentare_Kuwer.xlsm (Größe: 165,51 KB / Downloads: 2)

Gruß, Uwe

[MuMa0806]

@snb:

Bei deinem Code erhalte ich erneut einen "Laufzeitfehler 91: Objektvariable oder With-Blockvariable nicht festgelegt".

Code:

Sub M_snb(y As Integer)
  For Each it In Intersect(Selection.EntireRow, Range("L6:ON15")).SpecialCells(-4144)
    If Intersect(it.Offset(y), Range("L6:ON15")).SpecialCells(-4144) Is Nothing Then it.Offset(y).AddComment

    c00 = it.Offset(y).Comment.Text
    it.Offset(y).Comment.Text it.Comment.Text
    If c00 <> "" Then it.Comment.Text c00
  Next
End Sub

Nach dem debuggen wird mir der Code-Teil: c00 = it.Offset(y).Comment.Text angemarkert.
Ich habe keinerlei verbundene Zellen im benannten Bereich. Ich habe Zellen markiert, welche Kommentare enthalten und auch Zellen ohne Kommentare.

@Kuwer:

Super, dein Code macht das was er soll. Gibt es aber die Möglichkeit, dass nach Ausführung die betreffende Zeile "markiert" bleibt und ich diese weiter nach oben oder nach unten verschieben kann?

Ich kann Euch gar nicht genug für euren Ehrgeiz, mir bei dem "Problem" zu helfen, bedanken!!!

[Kuwer]

Hallo Marcel,

Code:

Sub KommentareTauschen(lngZ As Long)
  Dim oWsA As Worksheet
  Dim oWsT As Worksheet
  Dim rngZ As Range
  ActiveCell.Activate
  If ActiveCell.Row > 5 And lngZ + ActiveCell.Row > 5 Then
    Application.ScreenUpdating = False
    Set oWsA = ActiveSheet
    Set rngZ = Intersect(ActiveCell.EntireRow, Range("H:ON"))
    Set oWsT = Workbooks.Add(-4167).Worksheets(1)
    rngZ.Copy oWsT.Cells(1, 1)
    rngZ.ClearComments
    rngZ.Offset(lngZ).Copy oWsT.Cells(2, 1)
    rngZ.Offset(lngZ).ClearComments
    oWsT.Cells(1, 1).Resize(, rngZ.Columns.Count).Copy
    rngZ.Offset(lngZ).PasteSpecial Paste:=xlPasteComments
    oWsT.Cells(2, 1).Resize(, rngZ.Columns.Count).Copy
    rngZ.Offset(0).PasteSpecial Paste:=xlPasteComments
    Application.CutCopyMode = False
    oWsT.Parent.Close False
    rngZ.Offset(lngZ).Select
    Application.ScreenUpdating = True
  End If
End Sub

Gruß, Uwe

[snb]

Ich habe Zellen markiert, welche Kommentare enthalten und auch Zellen ohne Kommentare.

du brauchtst nur 1 Zelle im Gebiet J6:ON14  für +1 , oder J5:ON15 für  -1 zu selektieren

Teste mal:

PHP-Code:

Sub M_snb(y As Integer)
  If Selection.Row < 7 And y = -1 Or Selection.Row > 14 And y = 1 Then Exit Sub
  
  For Each it In Intersect(Selection.EntireRow, Range("L6:ON15")).SpecialCells(-4144)
    If Intersect(it.Offset(y), Range("L6:ON15").SpecialCells(-4144)) Is Nothing Then it.Offset(y).AddComment
    
    c00 = it.Offset(y).Comment.Text
    it.Offset(y).Comment.Text it.Comment.Text
    If c00 <> "" Then it.Comment.Text c00
  Next
End Sub 


[MuMa0806]

@Kuwer:

Vielen, vielen Dank!!! Jetzt erfüllt es alles, was ich mir wünsche! Super!!!

@snb:

Auch dein Code tut was es soll, er tauscht die Kommentare. Allerdings tauscht er nicht eine Zelle mit Kommentar gegen eine Zelle ohne Kommentar sondern kopiert diesen in die leere Zelle.


Viele Grüße an Euch beide!!!...ich bin begeistert!!!