• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

Tak už som vyriešila aj druhý problém so zachovaním vzorcov a odkazov. Len by som trochu potrebovala učesať makro, ktoré som si nahrala, aby nebolo také dlhé.

Mohla by som vybrať oblasť (Array), ale oddelenie OK má oblasť 29 a Očné iba 25, tak neviem ošetriť výnimku.
FaP som trochu skrátila, neviem či sa dá ešte viac.

Sheets("KUCH").Select
Range("E3").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$4"")"
Range("E3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("E3:E28"), Type:=xlFillDefault
Range("E3:E28").Select

Sheets("OK").Select
Range("E3").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$5"")"
Range("E3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("E3:E29"), Type:=xlFillDefault
Range("E3:E29").Select

Sheets("NK").Select
Range("E3").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$6"")"
Range("E3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("E3:E28"), Type:=xlFillDefault
Range("E3:E28").Select

Sheets("UK").Select
Range("E3").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$7"")"
Range("E3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("E3:E28"), Type:=xlFillDefault
Range("E3:E28").Select

Sheets("ORL").Select
Range("E3").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$8"")"
Range("E3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("E3:E28"), Type:=xlFillDefault
Range("E3:E28").Select

Sheets("OMFCH").Select
Range("E3").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$9"")"
Range("E3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("E3:E28"), Type:=xlFillDefault
Range("E3:E28").Select

Sheets("KPCH").Select
Range("E3").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$10"")"
Range("E3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("E3:E28"), Type:=xlFillDefault
Range("E3:E28").Select

Sheets("Očné").Select
Range("E3").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$11"")"
Range("E3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("E3:E25"), Type:=xlFillDefault
Range("E3:E25").Select

Sheets("FaP").Select
Range("B2").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$4"")"
Range("B3").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$5"")"
Range("B4").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$6"")"
Range("B5").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$7"")"
Range("B6").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$8"")"
Range("B7").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$9"")"
Range("B8").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""'zoznam pacientov'!$D$10"")"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Mám súbor s makrom, ktoré bolo tvorené pre excel 2003, teraz sa používa v exceli 2007.

Zmenila som všade v makre príponu súboru na xlsm.
Makro funguje, prebehne, súbory uloží s touto príponou, ale po opätovnom vytvorení vyhodí chybu.

Ako keby makro ukladalo naďalej v starom formáte excelu 2003.

A ešte by som potrebovala zachovať vzorce:
v zozname pacientov v stĺpci H
IF(LEN(C14<3;"";CHOOSE(TRUNC(MID(C14;3;1)/5)+1;"M";"Ž"))
v oddeleniach v stĺpci E v o blasti E3:E28
(prenos údajov zo zoznamu pacientov)

DOPLNENIE - prvý problém vyriešený, ďakujem

Potrebujem zmeniť kód farby v makre.
Makro bolo používané v exceli 2003, ale teraz prechodom na excel 2007 sa zmenila farba paleta štandardných farieb.


Const SLUZBA = "služba": Const COLOR_SLUZBA = 16711680
Const PRISLUZBA = "príslužba"
Const DODATOK = "dodatok": Const COLOR_DODATOK = 32768
Const PREKLAD = "preklad": Const COLOR_PREKLAD = 12632256
Const NEOP = "neop.": Const COLOR_NEOP = 255

https://www.youtube.com/watch?v=8RnOrEbOyR4

Tak som to celé zjednodušila.
Podľa tohto linku som si natvrdo vytvorila šablónu.
Do outlooku som hodila makro na vyvolanie šablóny.
A vytiahla tlačidlo.

Účel splnený. Považujem za vyriešené.

Sub mail()
Set msg = Application.CreateItemFromTemplate("C:\Users\meno\AppData\Roaming\Microsoft\Templates\template.oft")
msg.Display
End Sub

Použila som poslednú verziu.
Pri premenovaní súborov z xls na xlsx nebol problém.

Ale pri premenovaní z doc na docx mi word vykázal chybu. Nechcel otvoriť dokument.
Keď som ich znovu premenovala na doc, bolo ich možné otvoriť.

Dnes som si pozrela toto video.

Tento krok som už spravila pred jeho videním. Na makro-projekt to nemalo vplyv.

https://www.youtube.com/watch?v=GitPWH0RybQ

Už som zmenila aj šablóna NormalEmail, políčko nepridávať medzery za rovnakým štýlom je tam zaškrtnuté. Nová správa je už bez medzier, ale v projekte sa to neprejaví.

Na nepridávanie medzier som našla dva linky

https://stackoverflow.com/questions/23418243/how-can-i-programmatically-change-dont-add-space-between-paragraphs-of-the-sam

https://stackoverflow.com/questions/15522349/remove-space-before-and-after-in-outlook

Toto je funkčné, len neviem ako to pridať do makra.


Sub FixParagraphSpacing()
Dim objOL As Application
Dim objDoc As Object
Dim objSel As Object

Set objOL = Application
Set objDoc = objOL.ActiveInspector.WordEditor
Set objSel = objDoc.Windows(1).Selection

objSel.ParagraphFormat.SpaceBefore = 0
objSel.ParagraphFormat.SpaceBeforeAuto = False
objSel.ParagraphFormat.SpaceAfter = 0
objSel.ParagraphFormat.SpaceAfterAuto = False

Set objOL = Nothing
Set objDoc = Nothing
Set objSel = Nothing
End Sub

Makro funguje, ale pri prechode z 2003 do 2007 inak formátuje. A už si s tým neviem poradiť.

Za prvým riadkom po zaenterovaní odskočí riadok o 12 pt. V 2003 to nerobilo.

Novú poštovú správu mám formátovanú na Times New roman, 12 pt, ale Projekt spúšťaný makrom má Calibri, 11 pt.

Sub mail()
'-----------------------------------------
'DECLARE AND SET VARIABLES
Dim myOutlok As Object
Dim myMailItm As Object
Dim Signature As String
Set otlApp = CreateObject("Outlook.Application")
Set OtlNewMail = otlApp.CreateItem(olMailItem)
'-----------------------------------------
'GET DEFAULT EMAIL SIGNATURE
Signature = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(Signature, vbDirectory) <> vbNullString Then
Signature = Signature & Dir$(Signature & "*.htm")
Else:
Signature = ""
End If
Signature = CreateObject("Scripting.FileSystemObject").GetFile (Signature).OpenAsTextStream(1, -2).ReadAll
'-----------------------------------------
'CREATE EMAIL
OtlNewMail.HTMLBody = Signature
With OtlNewMail
.To = "menopriezvisko@.firma.sk"
.CC = ""
.Subject = "dodatok do MOSu!"
.HTMLBody = "<HTML><BODY>Dobrý deň!<br>Prosím o nahodenie dodatku do MOSu!<br>Ďakujem. <br><br><br><br><br></BODY></HTML>" & Signature
.Display
'.Send
End With
'-----------------------------------------
'CLEANUP
Set OtlNewMail = Nothing
Set otlApp = Nothing
Set otlAttach = Nothing
Set otlMess = Nothing
Set otlNSpace = Nothing
End Sub

DOPLNENIE

Tak dosiahla som font Times, zrušila som odsek ale veľkosť stále 11.

.HTMLBody = "<HTML><BODY><font face=times><font size=12px>text</p> </size></font></BODY></HTML>

Pozri.

https://support.microsoft.com/sk-sk/help/213609/how-to-hide-sheets-and-use-xlveryhidden-constant-in-a-macro


https://www.easyexcel.sk/kurz-excel-online/excel-makra-priklady/

Toto som vyskúšala, funguje.

Ako odkryť všetky hárky naraz vo VBA

Pre odkrytie všetkých skrytých hárkov naraz môžeme použiť nasledovné makro:

'Odkryje harky v zosite.
Sub odkryharky()
Dim Harok As Worksheet
For Each Harok In ActiveWorkbook.Worksheets
Harok.Visible = xlSheetVisible
Next Harok
End Sub

https://www.extendoffice.com/sk/documents/excel/672-excel-hide-display-sheet-tabs.html


https://www.porada.sk/t154980-odkryt-harky.html

Excel 2007 (pc v práci)

Keď použijem funkciu hľadať (ďaľekohľad), tak nájdená hodnota v danom stĺpci vôbec nie je farebne zreteľná od ostatných údajov.

V možnostiach excelu som nenašla nastavenie na iné zobrazenie farby.

Vyskúšala som si stĺpec aj vyfarbiť inou farbou, ale zmena pri funkciu hľadať sa neprejavila.

Mám makro na označenie aktívnej bunky, ale to mi nerieši situáciu, potrebujem farebne odlíšiť hľadanú bunku tak, aby som ju videla a nezanikla medzi ostatnými.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse