Omlouvam se za zpozdeni s odpovedi,byl jsem mimo domov.
Procedury v modulu listu.
Zabrana rucniho vlozeni dat do C3:C24:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("c3:c24")) Is Nothing Then
If Target.Value <> vbNullString Then
MsgBox "Nelze rucne zapisovat data do oblasti C3:C24"
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
End If
End If
End Sub
vkladani z clipboardu - dvojklik na cilovou bunku v C3:C24, je nutné nastavit odkaz na Microsoft Forms 2.0 Object Library: VBA>Tools>References...:' je nutné nastavit odkaz na Microsoft Forms 2.0 Object Library: VBA>Tools>References...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim DataObj As New MSForms.DataObject
Dim Tmp As Variant, OldData As String
With Target
If .Cells.Count = 1 Then
If Not Intersect(Target, Me.Range("c3:c24")) Is Nothing Then
OldData = .Value ' stara data ulozit
' vlozit data z clipboardu
DataObj.GetFromClipboard
Application.EnableEvents = False
Tmp = Split(DataObj.GetText, " ")
.Value = DataObj.GetText
' overit duplicitu
If Application.WorksheetFunction.CountIf(Range("c3:c24"), .Value) > 1 Then
.Interior.ColorIndex = 3 ' zvyraznit bunku
MsgBox "Duplicitni zadani"
.Value = OldData ' obnovit data a pozadi
.Interior.ColorIndex = xlNone
Else
' vlozit do B:B levou cast retezce po mezeru
.Offset(0, -1).Value = Tmp(0)
End If
Application.EnableEvents = True
.Offset(0, -1).Select
End If
End If
End With
Set DataObj = Nothing
End Sub
Snad to bude vyhovovat.