Zavrieť

Porady

Upraviť

Hlavné

Ďalšie rubriky

makro-word VYRIEŠENÉ

word 2007

Potrebujem použiť makro vo worde.

Predtým sa makro používalo v exceli, ale došlo k zmene spracovávaniu dát.

Tabuľka sa vytvorí klasickým kopírovaním a vložením. Potrebujem podľa premennej DODATOK,SLUžBA, PRíSLUžBA NEOP a PREKLAD. podfarbiť celý riadok.(pôvodne len bunku)

Ešte riešim podfarbenie prázdnych riadkov - oddelovačov medzi sálamil

DOPLNENIE Makro na podfarbenie prázdnych riadkov oddeľovačov medzi sálami funguje.
DOPLNENIE2 Makro formát funguje na konkrétny počet riadkov.

Zmenila som PREKLAD na podfarbenie riadku, lebo s podfarbením bunky mi to nefungovalo.
Pridaním a odstránením riadkov makro reaguje inak, lenže ja dopredu neviem, koľko riadkov, či sál a čísel na sále, a kde budú aké poznámky, to bol len názorný príklad, čo všetko sa tam môže vyskytnúť.

Je možné doplniť príkaz: najprv spočítaj riadky a potom aplikuj makro. Šlo by to?

DOPLNENIE3 počítanie riadkov pridané, makro format a farba spojené dokopy.
Code:
Sub formatafarba()


Dim i As Long, j As Long, k As Long, d As Long
With ActiveDocument
For i = 1 To .Tables.Count
With .Tables(i)
For j = 1 To .Rows.Count
With .Rows(j)
d = 0
For k = 1 To .Cells.Count
d = Len(.Cells(k).Range) + d
Next k
If d < 31 Then .Shading.BackgroundPatternColor = wdColorYellow
End With
Next j
End With
Next i
End With


Application.ScreenUpdating = False
a = Array("dodatok", "príslužba", "služba", "neop.", "preklad")
b = Array(wdColorGreen, wdColorBlue, wdColorBlue, wdColorRed, wdColorPlum)
For j = 0 To 4
For i = 1 To 17
With Selection.Find
.ClearFormatting
.Text = a(j)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.Execute
End With


With Selection
.HomeKey Unit:=wdLine
.MoveLeft Count:=14, Extend:=wdExtend
.Font.Color = b(j)
.Font.Bold = True
.MoveDown Unit:=wdLine, Count:=1
End With
Next i
Next j


Application.ScreenUpdating = True


End Sub
VYRIEŠENÉ Funguje.

DOPLNENIE4
Som si uvedomila že For i = 1 To 74, je blbosť.
Zmenila som na 10. Je predpoklad, že viac ako počet 5 nebude.
(Viac ako 5 dodatkov, 5 neop., 5 príslužba, 5 služba, 5 príslužba )
Možno by stačilo aj 5.

Prepočet sa zrýchlil.
Naposledy upravil Kabaka123 : 17.05.20 at 09:40
12 komentárov     zbaliť
misoft No ja si myslím, že pre vložené tabuľky (excelovské) vo worde makrá nefungujú. A makrá pre word nebudú fungovať vo vloženej tabuľke. Tie tabuľky sú jednoduché, bez uplatňovania makier.
Kabaka123 Časť funkčného makra už mám. A súbor musí mať koncovku docm. Inak makrá nefungujú. Koncovka docm nie je na porade podporovaná.
misoft Tak pre zmenu som sa zase ja niečo naučil .
Kabaka123 Kurzíva, výška 0,5 a font 9 sa môže nastaviť aj manuálne. Rozhodla som sa, že sa sály oddelia podfarbením celého riadka, ktorých ich oddeľuje, to bude stačiť.
marjankaj Sub podfarbiprazdnebunkyzltou()
Dim i As Long, j As Long, k As Long, d As Long
With ActiveDocument
For i = 1 To .Tables.Count
With .Tables(i)
For j = 1 To .Rows.Count
With .Rows(j)
d = 0
For k = 1 To .Cells.Count
d = Len(.Cells(k).Range) + d
Next k
If d < 31 Then .Shading.BackgroundPatternColor = wdColorYellow
End With
Next j
End With
Next i
End With
End Sub
Kabaka123 Ok toto makro na podfarbenie buniek žltou funguje. Ďakujem.
Je možné doriešiť predchádzajúce makro?
Nejakým príkazom, najprv spočítaj riadky a potom aplikuj formát?
marjankaj veď rows.count.
Ale ak je viac tabuliek tak treba počítať za všetky.
Ale lepšie je spočítať počet tých slov napr."neop"
Kabaka123 Idem otestovať. Ok, dala som to dokopy, zdá sa, že to funguje, pridám ešte riadky.
Pridala som spojené makro do otázky

Len otázočka, teraz For i = 1 To 17 má teraz nejaký význam? Mám to vyhodiť?
marjankaj no to je počet "dodatok"
počet "neop" je 20
nechať to cyklovať na počet riadkov je zbytočné predlženie výpočtu.
možno niekto dá efektívnejšie riešenie. Ja makrá vo worde veľmi neovládam.
Kabaka123 Ok jasné.
Vystačím si teda s tým čo mám.

Urobila som si prepočet sál.

Viac ako 74 riadkov by to nemalo byť.(aj s prázdymi riadkami - celá tabuľka)
Ak budú mať všetky sály po tri čísla a dve sály po 10.

17 som nahradila 74(ako riadky) teraz to funguje celkom dobre.
marjankaj No tu netreba počítať riadky, ale tiež to ide dlho


Sub podfarbiprazdnebunkyzltou()
Dim i As Long, j As Long, k As Long, m As Long, d As Long, x As String
Application.ScreenUpdating = False
a = Array("dodatok", "príslužba", "služba", "neop")
b = Array(wdColorGreen, wdColorBlue, wdColorBlue, wdColorRed)
With ActiveDocument
For i = 1 To .Tables.Count
With .Tables(i)
For j = 1 To .Rows.Count
With .Rows(j)

' vyfarbenie PREKLAD
x = Left(.Cells(.Cells.Count), 16)
x = Left(x, Len(x) - 2)
If x = "preklad" Then .Cells(.Cells.Count).Shading.BackgroundPatternColo r = wdColorLightGreen
' vyfarbenie riadkov
For m = 0 To 3
If x = a(m) Then .Select
With Selection
.Font.Color = b(m)
.Font.Bold = True
End With
Next m

' oddelenie sál
d = 0
For k = 1 To .Cells.Count
d = Len(.Cells(k).Range) + d
Next k
If d < 31 Then .Shading.BackgroundPatternColor = wdColorYellow


End With
Next j

End With
Next i
End With
Application.ScreenUpdating = True
End Sub
Kabaka123 Vyskúšam aj toto,,
Doplnila som otázku, nakoniec som to obmedzila na 5.

Ešte technická otázoočka: akú wdColorGray? mám zvoliť, aby bola poradne vyditeľná? Teraz mám namiesto nej BlueGray

https://docs.microsoft.com/en-us/off...i/word.wdcolor
Pravidlá a tipy
  • Každý móže napísať len 1 odpoveď. Neskor mozete svoju odpoveď vylepšiť.
  • Odpoveď má priniesť riešenie na otázku, vyvarujte sa hodnotenia otázky.
  • Odpoveď má byť viac o faktoch ako o názoroch.
Dalšie pravidla a tipy
Neregistrovaný
    Ak potrebujete v otázke niečo upresniť, najskôr sa spýtajte na podrobnosti.
    Koncept slúži na uloženie rozpracovanej odpovede, koncept sa zobrazuje len Vám, až kým ho nezverejníte.
    Ak máte podobnú otázku, založte Novú otázku alebo Súvisiacu otázku.
    ❤ Buďte priateľskí ❤
    Sme súčasťou jednej komunity, ktorá si chce vzájomne pomáhať, rozdieľnosť je vítaná ak neubližuje!
    Usporiadať podľa času

    marjankaj je offline (nepripojený) marjankaj

    I am a man marjankaj
    Sub aaaab()

    Application.ScreenUpdating = False

    a = Array("dodatok", "príslužba", "služba", "neop")
    b = Array(wdColorGreen, wdColorBlue, wdColorBlue, wdColorRed)
    For j = 0 To 3
    Selection.GoTo What:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:=""
    For i = 1 To 20
    With Selection.Find
    .ClearFormatting
    .Text = a(j)
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWholeWord = True
    .Execute
    End With

    With Selection
    .HomeKey Unit:=wdLine
    .MoveLeft Count:=14, Extend:=wdExtend
    .Font.Color = b(j)
    .Font.Bold = True
    .MoveDown Unit:=wdLine, Count:=1
    End With
    Next i
    Next j

    ' podfarbenie preklad
    Selection.Find.ClearFormatting
    With Selection.Find
    .Text = "preklad"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindAsk
    .Format = True
    .MatchCase = False
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    End With

    Selection.Shading.Texture = wdTextureNone
    Selection.Shading.ForegroundPatternColor = wdColorAutomatic
    Selection.Shading.BackgroundPatternColor = -603923969

    Application.ScreenUpdating = True
    End Sub

    Sub Makro5b()
    ' podfarbenie preklad
    Selection.Find.ClearFormatting
    With Selection.Find
    .Text = "preklad"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindAsk
    .Format = True
    .MatchCase = False
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    End With

    Selection.Shading.Texture = wdTextureNone
    Selection.Shading.ForegroundPatternColor = wdColorAutomatic
    Selection.Shading.BackgroundPatternColor = -603923969
    End Sub
    Naposledy upravil marjankaj : 16.05.20 at 17:32
    0
    7 komentáre - rozbaľ     zbaliť
    Kabaka123 Ďakujem, vyskúšala som. Nefunguje spoľallivo, Mením čísla hore dole. Musím teda upustiť od makra, kde budú premenné spolu, budem ich spúšťať samostatne.
    marjankaj čo ti nefunguje? Nič nemusíš meniť.
    Kabaka123 Aplikovala som, nefunguje. Podfarbuje ako che. VTvojom priloženom súbore nie je makro.
    marjankaj v pôvodnom dokumente si mala "neop." s bodkou a s bodkou je to aj v makre.
    Vyhoď z makra tú bodku.
    Kabaka123 Teraz už funguje. len preklad nie.
    DOPLNENIE: Zmenila som Preklad - podfarbenie bunky na podfarbenie textu. Teraz to už funguje.
    marjankaj ten preklad nefunguje. neviem prečo. veď si nahraj makro.
    Poprehadzovala si texty a aj pridala.
    Skús opravené.
    Kabaka123 DOPLNENIE2
    Jasné doplnením a odstránením riadkov podfarbuje inak, lenže ja neviem dopredu, koľko bude čísel na sále.
      zbaliť

    makro-word VYRIEŠENÉ

    Vieš, kto pozná odpoveď?
    Zdieľaj, možno sa nájde odborník Pozvi odborníka, firmu, inštitúciu atď.

    Porady, ktoré by vás mohli zaujímať

    Prihláste sa a sledujte len tie Porady, ktoré Vás zaujímajú.

    Pridať pochvalu

    Ďakujem Dobre píšes Super rada
    Vtipné Si cool Milé
    Poznámočka