Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailemVyřešeno Excel-VBA Duplicita_OddelitText

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

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny