První makro je na překlad textu z externího slovníčku a druhé makro hlídá změnu formátování, aby nebylo možné pomocí CTRL+C CTRL+V změnit formátování. Bohužel při použití makra na překlad to hodí error, protože pravděpodobně to druhé makro nedovolí změnu. pls help. Děkuji
Kód: Vybrat vše
Sub Incomes_doEN()
'překlad z cz do en
preloz (1)
End Sub
Sub Incomes_doCZ()
'překlad z en do cz
preloz (2)
End Sub
Sub preloz(xy As Integer)
'hlavní makro
Dim najdi As String, nahrad As String
Dim zdroj As Workbook, zdrojW As Worksheet
Dim iRows As Integer, a As Integer, x As Integer, y As Integer
If xy = 1 Then 'přeložení do cz
x = 1 'č. sloupku "odkud překládat"
y = 2 'č. sloupku "do čeho překládat"
ElseIf xy = 2 Then 'přeložení do en
x = 2 'č. sloupku "odkud překládat"
y = 1 'č. sloupku "do čeho překládat"
End If
Set zdroj = GetObject(ThisWorkbook.Path & "\slovnik.xlsx") 'otevře si slovník
Set zdrojW = zdroj.Worksheets(1)
With zdrojW
iRows = .Cells(Rows.Count, 1).End(xlUp).Row
For a = 1 To iRows
'načtení výrazu ze slovníku
najdi = .Cells(a, x)
nahrad = .Cells(a, y)
'najde a nahradí výrazy
Range("C:C").Replace What:=najdi, Replacement:=nahrad, LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next
End With
'zavře slovník
zdroj.Close (False)
Set zdroj = Nothing
End Sub
Kód: Vybrat vše
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngHlidani As Range
Dim VlozenaHodnota As Variant
'nastaveni hlidani oblasti
Set rngHlidani = Range("A3:D200")
VlozenaHodnota = Target.Value
' pokud je vybrana bunka z definovane oblasti tak proved
If Union(rngHlidani, Target).Address = rngHlidani.Address Then
With Application
.EnableEvents = False
.Undo
Range(Target.Address) = VlozenaHodnota
.EnableEvents = True
End With
End If
End Sub