Nemusis se omlouvat za nehledani na Googlu, spis se omlouvam ja, ze jsem dusledne neosetril stav, kdy je clipboard prazdny.
Procedura po vznikle chybe a ukonceni behu celkem zakonite nemohla pri opakovanem zavolani pracovat, nebot nedoslo v dusledku predcasneho ukonceni procedury k obnove zachytavani udalosti nenastavenim vlastnosti Application.EnableEvents = True. Pro takovyto pripad staci pouzit proceduru:
Sub AEE()
Application.EnableEvents = True
End Sub
Procedura Private Sub Worksheet_BeforeDoubleClick je doplnena o kontrolu, zda neni clipboard prazdny a upravena, nahrad predchozi proceduru:
' je nutné nastavit odkaz na Microsoft Forms 2.0 Object Library: VBA>Tools>References...
' Excel 12 Tools>References>Browse a najit soubor FM20.dll a Otevrit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim DataObj As New MSForms.DataObject
Dim Tmp As Variant, OldData As String, OldIntCol As Integer
Dim TmpStr As String, Response As Byte
With Target
If .Cells.Count = 1 Then
If Not Intersect(Target, Me.Range("c3:c24")) Is Nothing Then
OldData = .Value ' stara data ulozit
OldIntCol = .Interior.ColorIndex
' obsah clipboardu a kontrola neprazdnosti
DataObj.GetFromClipboard
TmpStr = Trim(DataObj.GetText)
If TmpStr = vbNullString Then
Response = MsgBox("Clipboard je prazdny", vbExclamation)
Else
Application.EnableEvents = False
' vlozit data z clipboardu
.Value = TmpStr
' overit duplicitu
If Application.WorksheetFunction.CountIf(Range("c3:c24"), .Value) > 1 Then
.Interior.ColorIndex = 3 ' zvyraznit bunku
Response = MsgBox("Duplicitni zadani", vbExclamation)
.Value = OldData ' obnovit data a pozadi
.Interior.ColorIndex = OldIntCol
Else
' vlozit do B:B levou cast retezce po mezeru
Tmp = Split(TmpStr, " ")
.Offset(0, -1).Value = Tmp(0)
End If
Application.EnableEvents = True
End If
.Offset(0, -1).Select
End If
End If
End With
Set DataObj = Nothing
Exit Sub
End Sub