Hier mal der gesamte code, ich markiere mal die zeile, wo der fehler auftaucht.
Sub sync_pages()
Dim i As Integer
'check if online
'Dim Ret As Long
' Ret = InternetGetConnectedStateEx(Ret, sConnType, 254, 0)
' If Ret 1 Then
' MsgBox "Du bist nicht online! Die Synchronisation mit der entfernten Datei kann nur _
online erfolgen"
' Exit Sub
' End If
Application.EnableEvents = False
Dim WksLocal As Worksheet
Dim WksRemote As Worksheet
'Set WksLocal = ActiveSheet
Set WksLocal = Worksheets("Seitenspiegel")
Set WksRemote = Workbooks("test_sync.xlsm").Worksheets("Seitenspiegel")
'Unprotect
WksLocal.Unprotect password:=passw
WksRemote.Unprotect password:=passw
'Show graphic while sync
Dim meInfo As Shape
Set meInfo = WksLocal.Shapes("find") name of image file
With ActiveWindow.VisibleRange
meInfo.Width = 800 * .Width / 1270.5
meInfo.Height = 200 * .Height / 648
meInfo.Left = .Left + .Width / 2 - meInfo.Width / 2 - 200 'pos. Horizontal
meInfo.Top = .Top + .Height / 2 - meInfo.Height / 2 - 30 'pos. Vertikal
End With
meInfo.Visible = True
For i = 9 To 100 'Assuming less than 100 lines!
If WksLocal.Cells(i, 1) "" And WksLocal.Cells(i, 4) WksRemote.Cells(i, 4) Then 'only sync _
non-empty
If WksLocal.Cells(i, 4) WksLocal.Cells(i, 2).Comment.Text Text:=WksRemote.Cells(i, 2).Comment.Text
WksLocal.Cells(i, 3) = WksRemote.Cells(i, 3)
WksLocal.Cells(i, 4) = WksRemote.Cells(i, 4)
Else
'updating remote
If WksLocal.Cells(i, 4) WksRemote.Cells(i, 4) Then 'only update if different
WksRemote.Cells(i, 2) = WksLocal.Cells(i, 2)
If Not WksRemote.Cells(i, 2).Comment Is Nothing Then 'Delete if Comment exists
WksRemote.Cells(i, 2).Comment.Delete
End If
WksRemote.Cells(i, 2).AddComment
WksRemote.Cells(i, 2).ClearComments
'MsgBox WksRemote.Cells(i, 2).Comment & WksRemote.Cells(i, 2).Comment
WksRemote.Cells(i, 2).Comment.Text Text:=WksLocal.Cells(i, 2).Comment.Text
WksRemote.Cells(i, 3) = WksLocal.Cells(i, 3)
WksRemote.Cells(i, 4) = WksLocal.Cells(i, 4)
End If
End If
Else
'delete empty cells with comments
If Not WksRemote.Cells(i, 2).Comment Is Nothing Then
If WksRemote.Cells(i, 2) = "" Then
'WksRemote.Cells(i, 2).Comment.Clear
WksRemote.Cells(i, 2).Comment.Delete
End If
End If
If Not WksLocal.Cells(i, 2).Comment Is Nothing Then
If WksLocal.Cells(i, 2) = "" Then
WksLocal.Cells(i, 2).Comment.Delete
End If
End If
End If
Next i
meInfo.Visible = False
WksLocal.Protect password:=passw
WksRemote.Protect password:=passw
Application.EnableEvents = True
End Sub