Nespolupráce dvou maker Vyřešeno

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Lůjík
nováček
Příspěvky: 19
Registrován: listopad 13
Pohlaví: Žena
Stav:
Offline

Nespolupráce dvou maker

Příspěvekod Lůjík » 04 bře 2014 10:16

Ahoj, prosím o pomoc, zde na foru jste mi postupně poradili několik maker. Aktuálně se mi, ale dvě tlučou a nefungují společně. Poradili byste mi, co upravit, aby se zkamarádili?

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

Reklama
cmuch
Level 4.5
Level 4.5
Příspěvky: 1544
Registrován: březen 11
Bydliště: Drsná Vysočina :D
Pohlaví: Muž
Stav:
Offline

Re: Nespolupráce dvou maker  Vyřešeno

Příspěvekod cmuch » 04 bře 2014 10:57

Ahoj, v tom prvním makru před řádek
'najde a nahradí výrazy vlož

Kód: Vybrat vše

Application.EnableEvents = False

a za ten příkaz nahrazení dej zas opak

Kód: Vybrat vše

Application.EnableEvents = True


Toto zabrání spuštění toho druhého makra.


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Fúze dvou PC
    od Luis » 10 čer 2023 15:04 » v Rady s výběrem hw a sestavením PC
    4
    672
    od petr22 Zobrazit poslední příspěvek
    11 čer 2023 13:51
  • Scan a tisk u dvou tiskáren
    od amirinda » 14 říj 2023 06:49 » v Vše ostatní (sw)
    12
    1749
    od amirinda Zobrazit poslední příspěvek
    14 říj 2023 16:39
  • Který z těchto dvou mobilů vybrat
    od Lukáš.v89 » 06 úno 2024 00:50 » v Mobily, tablety a jiná přenosná zařízení
    8
    807
    od Smile Zobrazit poslední příspěvek
    07 úno 2024 07:40

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 5 hostů