Příspěvky uživatele
< návrat zpět
€Ł мσşqμΐτσ napsal/a:
Dobrý den, do sešitu jsem vložil nový modul. Makro se nyní spouští automaticky po otevření souboru a po potvrzení načtení dat nabídne možnost vytvořit tiskový list a zobrazit náhled tisku.
Ďakujem veľmi krásne. Toto je parádička.
Už s kolegyňou uvážime hlavičky. Strana x/y o tom som uvažovala. Toto je ono. Aj keď tlač zrušila hrubé oddelenie čiar medzi sálami, nevadí. Na tieto účely to postačí.
Takto vyzerá súbor pripravený na tlač.
Toto zoskupenie robím manuálne cez doplnok RJ Tools od Radka Jurečka.
Postup je makro, manuálne zoskupenie doĽava a zalomiť a potom makro hotovo (dá sa spustiť ctrl+y)
V súbore pripravenom na tlač v stĺpci C je zlúčený obsah stĺpcov: nazovdiagnozy, vykon, výkon_doplnok, stitky poznamka, poznamkaoaim , slovnik-anesteza, slovnik-poloha_pac, slovnik-strana_vyk - ale v názve je už len názov diagnozy, vykon, anesteza, poloha_pac a strana_vyk
Súbor na tlač má mierku 100 %, bez zmenšenia.
€Ł мσşqμΐτσ napsal/a:
Dobrý den, nejsem si úplně jistý, zda jsem správně pochopil celé zadání, ale připravil jsem jednoduché makro podle původního popisu.
(33kB, staženo 1x)
Ďakujem, že ste tomu venovali čas. Vyzerá to sľubne. Medzitým ako ja som dumala nad tlačou, tak na serveri pribudli ďalšie tri stĺpce. A tiež došlo k preusporiadaniu stĺpcov. Prikladám novú prílohu.
Názvy stĺpcov zas sebou sú takéto
1 umiestneniekod
2 skratnazov
3 pacient
4 rodcis
5 kodpoist
6 dg
7 nazovdiagnozy
8 vykon
9 výkon_doplnok
10 stitky
11 poznamka
12 poznamkaoaim
13 slovnik-anesteza
14 slovnik-poloha_pac
15 slovnik-strana_vyk
16 rdgtechnik
17 operater
18 anesteziolog
19 anestsestra
20 instrumentar
21 poznamkacos - na ten som zabudla
Súbor, ktorý si ukladáme obsahuje aj anestsestra, ale súbor , ktorý tlačíme, tento stĺpec neobsahuje.
Nie je nutná farebná tlač, máme čiernobielu tlačiareň.
Makro zdroj-makro tlač čerpá údaje zo zdroj.xls
Makro zdroj-promis tlač čerpá údaje zo zdroj.xlsx.
Hárok v zošite zdroj.xls sa volá makro.
Tento zdroj je export priamo zo serveru
Hárok v zošite zdroj.xlsx sa volá promis.
Tento zdroj je kópia už vytvoreného súboru Akt OP dátum 2025
Prvé makro sa použije ak je OP kompletný.
Vytvorí súbor, uloží na plochu ako Akt OP dátum
(resp. tam, kde bolo makro spustené, u nás je to plocha)
Druhé makro sa použije v prípade ak OP nie je kompletný a kolegyňa ho doplní neskôr a potom vytlačí.
Keby som to vedela dať do vba bolo by to super.
Vedel by mi niekto poradiť ako sofistikovane a inteligentne vytlačiť veľký excelovský súbor na A4 tak, aby bolo písmo čítateľné? (office 2007)
TLAČ na A4 na šírku okraje 0,5 0,5 0,5 0,5
font arial 9 (najmenej)
umiestneniekod, skratnazov - 1 stĺpec
pacient, rodné číslo, diagnózu a poisťovnu spojiť do 1 stĺpca
názov diagnózy a výkon - 1 stĺpec
vykon_doplnok, štítky, poznamka, poznamkaKAIM - 1 stlpec
strana_vyk, poloha pacienta, anesteza, 1 stĺpec
stlpec anestsestra-netlačiť
Doplnenie.
Našla som v doplnku RJtools možnosť zoskupiť obsah buniek zľava a zalomiť. Škoda že danu funkciu nezachytava nahrane makro. Ale skombinujem to a dosiahnem želaný efekt.
Začátečník napsal/a:
V příloze varianty
Ďakujem veľmi pekne za varianty. Tá prvá je super.
Začátečník napsal/a:
Řazení jsem přehlédl, upravený kód včetně řazení podle sloupce T a A)
Ďakuje veľmi pekne. Teraz to funguje ako má.
€Ł мσşqμΐτσ napsal/a:
Stačí přidat řádek
.Range("A3:T" & posledni).Sort Key1:=.Range("T3"), Order1:=xlAscending, Header:=xlYes
Ďakujem pekne. Ale ignoruje stĺpec A.
Ide o zoradenie podľa 2 podmienok. Stĺpec A a T.
Začátečník napsal/a:
Upravený kód (podle návrhu €Ł мσşqμΐτσ).
Geniálne funguje to perfektne. Ďakujem veľmi pekne.
Má to len 1 malú chybičku. Nezoraďuje riadky podľa posledného stĺpca T.
Prikladám súbor.
Začátečník napsal/a:
EDIT:pokud jde o pouhé uložení
Super, toto je ono. To je presne to, čo som potrebovala.
Uložiť a vytvoriť xlsx a vymazať dáta makre. Toto mi stačí.
Ďakujem.
Ale ešte potrebujem pridať vyfarbenie konštany neop. dodatok, služba a príslužba. /neop. červená, dodatok, zelená a služba a príslužba modrá/
Áno súbor makro promis.xlsm má slúžiť na spustenie makra.
EDIT
' otvorit zdrojovy subor s datami
Workbooks.Open Filename:="C:\Users\P1511CEA\Desktop\zdroj.xls"
Zdrojový súbor sa bude volať vždy rovnako zdroj.
Pridala som do makra ešte kód. Súbor makro promis.xlsm rovno otvorí súbor zdroj.xlsx
Hárok v zdroji sa musí volať makro a hárok v zdroji sa musí volať promis, aby to fungovalo tak ako má.
V súbori zdroj pridávam 2 riadky. Do bunky J napíšem Aktualizovaný OP, a do bunky AG1 dátum.
Vymenená príloha. Je to to isté, len s jedným pridaným kódom.
Dobrý deň
Potrebujem pomoc, prosím, ďakujem.
Mám 2 súbory. zdroj.xls, exportovaný zo serveru a uložený ako xls, dáta ručne kopírujem do súboru makro promis.xlsm (office 2007)
Makro funguje.
Ale ešte chcem, aby po uložení súboru xlsx, sa vymazali dáta v pôvodnom xlsm súbore. A to sa mi nedarí.
Sub OPpromisakt()
' vymazat stlpce
Columns("A:I").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("L:L").Select
Selection.Delete Shift:=xlToLeft
Columns("O:U").Select
Selection.Delete Shift:=xlToLeft
Columns("R:V").Select
Selection.Delete Shift:=xlToLeft
' usporiadat stlpce
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Columns("P:P").Select
Selection.Cut
Range("B1").Select
ActiveSheet.Paste
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("R:R").Select
Selection.Cut
Range("C1").Select
ActiveSheet.Paste
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Columns("T:T").Select
Selection.Cut
Range("E1").Select
ActiveSheet.Paste
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Columns("V:V").Select
Selection.Cut
Range("G1").Select
ActiveSheet.Paste
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Columns("P:P").Select
Selection.Cut
Range("I1").Select
ActiveSheet.Paste
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("U:U").Select
Selection.Cut
Range("J1").Select
ActiveSheet.Paste
Columns("V:V").Select
Selection.Cut
Range("K1").Select
ActiveSheet.Paste
Columns("AC:AC").Select
Selection.Cut
Range("L1").Select
ActiveSheet.Paste
Columns("AB:AB").Select
Selection.Cut
Range("M1").Select
ActiveSheet.Paste
Columns("Q:Q").Select
Selection.Insert Shift:=xlToRight
Columns("S:S").Select
Selection.Cut
Range("Q1").Select
ActiveSheet.Paste
Columns("S:S").Select
Selection.Delete Shift:=xlToLeft
Columns("T:V").Select
Range("V1").Activate
Selection.Delete Shift:=xlToLeft
'odstraniť nepotrebné riadky
Dim ws As Worksheet
Dim i As Long
Set ws = ThisWorkbook.Sheets("makro")
' Loop from the last row in column F (Department) to the first row
For i = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row To 2 Step -1
If ws.Cells(i, "A").Value = "CZS_01" Then
ws.Rows(i).Delete
End If
Next i
For i = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row To 2 Step -1
If ws.Cells(i, "A").Value = "CZS_02" Then
ws.Rows(i).Delete
End If
Next i
For i = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row To 2 Step -1
If ws.Cells(i, "A").Value = "CZS_03" Then
ws.Rows(i).Delete
End If
Next i
For i = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row To 2 Step -1
If ws.Cells(i, "A").Value = "CZS_04" Then
ws.Rows(i).Delete
End If
Next i
For i = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row To 2 Step -1
If ws.Cells(i, "A").Value = "CZS_05" Then
ws.Rows(i).Delete
End If
Next i
For i = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row To 2 Step -1
If ws.Cells(i, "A").Value = "ENDO" Then
ws.Rows(i).Delete
End If
Next i
For i = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row To 2 Step -1
If ws.Cells(i, "A").Value = "Bronchoskopia" Then
ws.Rows(i).Delete
End If
Next i
For i = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row To 2 Step -1
If ws.Cells(i, "A").Value = "Kolonoskopia" Then
ws.Rows(i).Delete
End If
Next i
For i = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row To 2 Step -1
If ws.Cells(i, "A").Value = "LITO / RTG" Then
ws.Rows(i).Delete
End If
Next i
For i = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row To 2 Step -1
If ws.Cells(i, "A").Value = "RTG-CT " Then
ws.Rows(i).Delete
End If
Next i
For i = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row To 2 Step -1
If ws.Cells(i, "A").Value = "RTG-ERCP" Then
ws.Rows(i).Delete
End If
Next i
'ulozit
Dim Cesta As String, Subor As String, Mesiac As String, Datum As Date
Const ZDROJ_DATUMU = "makro"
Typ = IIf(Val(Application.Version) < 11, xlOpenXMLWorkbook, 51)
Cesta = ThisWorkbook.Path & "\"
Datum = Worksheets(ZDROJ_DATUMU).Cells(1, 2)
Mesiac = Format(Datum, "dd.mm.yyyy")
Subor = Cesta & "Akt OP " & Mesiac & ".xlsx"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs filename:=Subor, FileFormat:=Typ, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Nechce mi pridať originál súbor pdf zbalený v zipe.
Súbor má veľkosť 515kb. Prekračuje povolenú veľkosť.
Urobím to inak. Prekonvertujem to cez online konvertor a bude.
elninoslov napsal/a:
EDIT: Napadá ma predsa len dôvod, prečo vynechať 1. písmeno. Ak sa jedná o pridanie medzery do zle zložených mien. Namiesto "MenoPriezvisko" urobí "Meno Priezvisko". V takomto prípade je nutné vynechanie 1. znaku, aby nevzniklo " Meno Priezvisko". Takže aký je účel?
Účel je taký, že presne to potrebujem. Aby z MenoPriezvisko urobilo Meno Priezvisko. Kopírovala som zoznam zamestnancov z PDF do excelu.
Štruktúra PDF dokumentu je: Priezvisko, Meno, Titul, Oddelenie
Údaje v exceli sú v jednom stĺpci, potrebujem ich rozdeliť na 4 resp. 2 stĺpce
Priezvisko meno titul, Oddelenie
Lenže neviem ošetriť, aby Priezvisko meno a titul boli spolu, oddelenie v jednom stĺpci, a všetky tituly spolu.
Tak som údaje zbavila medzier a preto chcem teraz vložiť medzeru pred veľké písmeno. Viem, že som si to skomplikovala.
Ďakujem, teraz to už funguje.
elninoslov napsal/a:
Samozrejme to pôjde, ale najskôr otázka :
Prečo sa vynecháva ten 1. znak ???
Netuším, aký prvý znak sa vynecháva. Našla som funkciu. Skopírovala, vložila, spustila, funguje, len diakritiku ignoruje. Do funkcie som nezasahovala.
Táto funkcia vloží medzeru pred veľké písmeno, ale ignoruje mäkčene
Ak to prosím upraviť, aby to bralo do úvahy diakritiku. Ďakujem.
Function AddSpaces(pValue As String) As String
'Update 20140723
Dim xOut As String
xOut = VBA.Left(pValue, 1)
For i = 2 To VBA.Len(pValue)
xAsc = VBA.Asc(VBA.Mid(pValue, i, 1))
If xAsc >= 65 And xAsc <= 90 Then
xOut = xOut & " " & VBA.Mid(pValue, i, 1)
Else
xOut = xOut & VBA.Mid(pValue, i, 1)
End If
Next
AddSpaces = xOut
End Function
VYRIEŠENÉ Funkcia upravená elninoslovom funguje. Ale nakoniec som pdf súbor prekonvertovala online konvertorom do excelu. Ďakujem.
Uživatelské menu
\nFormulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články