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

Příspěvky uživatele

Ten kód predsa musíte dať do listu "List4", lebo ten sa prepočítava, a pri tomto prepočítaní sa aktualizuje Textové pole v liste Hárok1, teda zmente tento riadok na :
With Hárok1.Shapes("txtPoleSpolu").TextFrame2.TextRange
Tieto riadky tam niesú potrebné ak nemeníte nikde farbu:
Dim text As String
.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
a 2x
.Fill.ForeColor.RGB = RGB(0, 0, 0)

Možno tak jedine udalostné makro ("Calculate"), vzorec tam nemôže byť.

No máte tam v S1
12Kč / likometr
nemá to byť
12Kč / kilometr
?

Hmm, no je pravda, že je to trochu svojsky riešené. To nieje výtka. Ja by som si vyberal napr aj mená z výberového zoznamu (Overenie dát) bez prepínania listu. Ak je potrebné veľmi často zadávať doteraz nepoužité mená, tak VBA formulárom. Každopádne teraz na to nemám chuť

Len 2 poznámky:
-To mazanie čo spomínate (a to len tipujem, neskúmal som) je možno tým, že nepoužívate premennú na uchovanie hodnoty, ale neustále hľadáte prvý voľný riadok v A. Ten nájde, ale ak zapíšete do A novú hodnotu, v ďalšom riadku kódu chcete písať do B, ale ako prvá prázdna bunka v A už nieje tá, ako pred chvíľou, lebo ste ju zapísal. A bunky treba zapísať naraz, nie po jednej.
-A druhá poznámka s tým súvisí, tie makrá by sa mali prepracovať. Dajú sa urobiť oveľa jednoduchšie, napr. mazanie hodnôt
Sub VYMAZ()
With ActiveSheet
.Unprotect "0000"
.Shapes(Application.Caller).TopLeftCell.Offset(0, -10).Resize(, 10).ClearContents
.Protect "0000"
End With
End Sub
alebo to pridávanie žiadosti:
Sub PRIDAJ_DO_ZOZNAMU_ZIADOSTI()
With ActiveSheet
If .Range("H2").Value = 47 Or .Range("I2").Value = 47 Or .Range("J2").Value = 47 Then Exit Sub
.Unprotect "0000"
.Cells(19, 1).End(xlDown).Offset(1, 0).Resize(, 9).Value = Array(.Cells(9, 2), .Cells(9, 3), .Cells(9, 6), .Cells(12, 2), .Cells(12, 3), .Cells(12, 6), .Cells(7, 2), .Cells(7, 9), .Cells(9, 9))
.Cells(2, 1).Resize(, 10).Formula = Array(0, 0, 0, "=C2/2", 0, "=E2/2", 0, 47, 47, 47)
.Protect "0000"
End With
End Sub
atď...

A opravte si tú kilometrovú sadzbu (opravte, nie upravte)

Polovica kódu, je tam len preto aby Vám ukázalo vizuál v bunkách, no makro ich nepotrebuje.
Sub ListFiles()
Dim i As Long, sFile As String, sLeftFile As String, sPath As String, fileSaveName As String, sVal As String, colFiles As New Collection
Dim arrFiles() As String, iFiles As Long, iCol

With ThisWorkbook.Worksheets("Tomas")
sPath = .Cells(1, 4).Value
If Len(sPath) = 0 Or Len(Dir(sPath)) = 0 Then MsgBox "Chýba zdroj", vbCritical: Exit Sub

sFile = Dir(sPath & "*.*", vbNormal)
On Error Resume Next
While sFile <> ""
sLeftFile = Split(sFile, "_")(0)
colFiles.Add Array(sFile, sLeftFile), sLeftFile

If Err.Number = 0 Then
sVal = sVal & IIf(LenB(sVal) = 0, vbNullString, vbCrLf) & sLeftFile
Else
Err.Clear
End If
sFile = Dir()
Wend
On Error GoTo 0
With .Columns(1).Resize(2)
.ClearContents

ReDim arrFiles(1 To colFiles.Count, 1 To 2)
i = 0
For Each iCol In colFiles
i = i + 1
arrFiles(i, 1) = iCol(0)
arrFiles(i, 2) = iCol(1)
Next iCol
.Resize(i, 2).Value = arrFiles
End With
End With

fileSaveName = Application.GetSaveAsFilename(InitialFileName:="c:\1\" & Format(Now, "yyyymmddhhnn"), _
fileFilter:="Semicolon separated CSV (*.csv), *.csv")

If fileSaveName <> "False" Then
i = FreeFile
Open fileSaveName For Output As #i
Print #i, sVal
Close #i
End If
End Sub

Ak to chcete robiť cez Copy, tak to musíte aj niekam prilepiť. A to nerobíte. Pozrite sa napr. sem. Vám tam absentuje vytvorenie cieľového súboru.

EIDT: Alebo to urobte úplne inak, napr. takto, rýchlo, bez kopírovania, bez vytvárania nového okna Excelu:
Sub export_first()
Dim rngArea As Range, i As Long, iRow As Long, sVal As String, arrVal(), fileSaveName As String
With Sheets("Tomas").Range("B1:B20")
arrVal = .Value

For Each rngArea In .SpecialCells(xlCellTypeVisible).Areas
With rngArea
iRow = .Row

For i = iRow To iRow + .Rows.Count - 1
sVal = sVal & IIf(LenB(sVal) = 0, vbNullString, vbCrLf) & arrVal(i, 1)
Next i
End With
Next rngArea

End With
fileSaveName = Application.GetSaveAsFilename(InitialFileName:="c:\1\" & Format(Now, "yyyymmddhhnn"), _
fileFilter:="Semicolon separated CSV (*.csv), *.csv")

If fileSaveName <> "False" Then
i = FreeFile
Open fileSaveName For Output As #i
Print #i, sVal
Close #i
End If
End Sub
Ešte bude záležať na tom, aký typ údajov tam máte.

Príklad:
Cells(10, 5).Interior.Color = RGB(Cells(7, 4), Cells(8, 4), Cells(9, 4))

@AL: A keby ste dal písmo podkladovou farbou, a doplnil ten Váš formát o čiernu farbu ?
[Čierna][>0,02] 0%;[Čierna][<-0,02] -0%; ""
Alebo, musí to byť Vlastný formát ? Nemôžete si pomôcť Podmieneným formátom ?

To preto, lebo listy nemajú rovnaké DPI. Nastavte im rovnaké a pôjde to OK.

EDIT: Konkrétne strany 1, 4 nemajú nastavené žiadne DPI, a strany 2, 3, 5 majú 600 DPI.

No to bude záležať na tom, čo sa má s ktorými súbormi robiť. Nieje vôbec jasné požitie. Či sa distribuuje aj zdroj aj súbory súčasne a spolu, či sa mení cesta k zdroju či cesta k súborom, či môžu obsahovať makro aj samotné súbory, ... nič, žiadne upresnenie... .

Tak to je ale potom zvláštne. Keď tam majú dáta pribúdať, načo potom makrom vkladať vždy na to isté miesto vzorce a formátovať hlavičku ? Veď to urobte raz manuálne, a nepotrebujete na to opakovane makro, zbytočne, lebo to už je vykonané.
A keď si z obyčajnej tabuľky urobíte objekt Tabuľka (Ctrl+T), tak sa budú vzorce kopírovať do ďalších pridaných riadkov automaticky samé.
Otázkou je, akým spôsobom budú pribúdať údaje.
Ak ručne, tak je potreba potom ručne (alebo makrom) reinicializovať opätovné zoradenie.
Ak pribúdajú makrom, treba túto reinicializáciu vyvolať rovno pri importe.

No a na druhej strane, ak tie úpravy potrebujete robiť opakovane na nejaký export súbor od neviem odkiaľ, tak do export/reportu nemôžete pridávať dáta. Potom to už nezodpovedá tomu reportu. A zároveň je to v rozpore toho vyššie spomínaného opakovaného formátovania.

Alebo ???

Tu máte príklad takej Tabuľky. Stačí iba skopírovať z nejakého nového reportu/exportu/výkazu nové dáta na prvý voľný riadok pod Tabuľku. Vzorce v I:J sa doplnia samé. Potom už iba na karte Údaje kliknite v skupine Zoradiť a filtrovať na Znovu použiť. Neviem, či Vám celá operácia zaberie 10 sek. V dátach ale vidím typický neduh týchto exportov - zlý formát dát. Stĺpec A musí byť formát Text (ID materiálov sú aj číselné aj textočíselné, aby to nespôsobovalo problém napr pri vyhľadávaní 0123 vs 123), C:D sú čísla ako text a majú to byť čísla.
-buď ich pri exporte (ak to ide navoliť) exportujte správne
-alebo ich pri importe (ak vôbec importujete, možno máte už hotový súbor xlsx a nie napr. csv a pod.) zformátujte
-alebo použite:
---do bunky niekde bokom dočasne napíšte 1, túto bunku dajte Ctrl+C
---označte celé stĺpce Tabuľky "tblData[[Závod]:[Sklad]]" na hlalvičke týchto stĺpcov
---pravý klik na označené - Prilepiť špeciálne - Hodnoty - Násobenie - OK
---Zmažte tú 1-tku, a sú z toho skutočné čísla.
-alebo označte najskôr v Tabuľke stĺpec Závod (opäť na hlavičke, taká malá šípka), na karte Údaje - Text na stĺpce - Ďalej - Ďalej - Dokončiť. Potom to isté urobte so stĺpcom Sklad.

Všetko sú to jednoduché operácie, a žiadne makro zatiaľ nieje potreba. Usudzujem totiž, že nieje možné použiť súbor s makrom, ak makrom z iného súboru upravujete tento xlsx. Inak by mal predsa tento súbor makro v sebe, a nemuselo by sa to riešiť cez 2 súbory.

Key1:=Range("I1")
musíte zmeniť na
Key1:=Workbooks("sklad_2100.xlsx").Worksheets("Sheet1").Range("I1")
alebo zmente kód na napr. takýto:
Private Sub CommandButton1_Click()
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1")
.Range("A1:J1300").Sort Key1:=.Range("I1"), Order1:=xlDescending, Header:=xlYes
End With
End Sub

Private Sub Formatovani_Click()
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1").Range("I1")
.Interior.Color = RGB(0, 255, 0)
.ColumnWidth = 20
.Value = "Rozdíl Fyz. - SAP"
.VerticalAlignment = xlTop
End With

With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1").Range("J1")
.Interior.Color = RGB(255, 255, 0)
.ColumnWidth = 20
.Value = "Absol. hod."
.VerticalAlignment = xlTop
End With

With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1")
.Range("I2:I1300").Formula = "=H2-F2"
.Range("J2:J1300").Formula = "=ABS(I2)"
End With
End Sub

Prípadne obe procedúry dokopy a na menej krokov:
Private Sub Formatovani_Click()
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1")
With .Range("I1:J1")
.ColumnWidth = 20
.Value = Array("Rozdíl Fyz. - SAP", "Absol. hod.")
.VerticalAlignment = xlTop
End With

.Range("I1").Interior.Color = RGB(0, 255, 0)
.Range("J1").Interior.Color = RGB(255, 255, 0)

.Range("I2:J1300").Formula = Array("=H2-F2", "=ABS(I2)")
.Range("A1:J1300").Sort Key1:=.Range("I1"), Order1:=xlDescending, Header:=xlYes
End With
End Sub
Aj tak sa mi nezdá, to vkladanie vzorcov na 1300 riadkov. Určite ? Netreba to náhodou len na taký počet riadkov, koľko je dát ? Lebo teraz to dá tie záporné hodnoty až za 0 (nuly), čo je od riadku 1300 vyššie.

Takto by mi to viacej dávalo zmysel:
Private Sub Formatovani_Click()
Dim Riadkov As Long
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1")
With .Range("I1:J1")
.ColumnWidth = 20
.Value = Array("Rozdíl Fyz. - SAP", "Absol. hod.")
.VerticalAlignment = xlTop
End With

.Range("I1").Interior.Color = RGB(0, 255, 0)
.Range("J1").Interior.Color = RGB(255, 255, 0)

Riadkov = .Cells(Rows.Count, 1).End(xlUp).Row
If Riadkov > 1 Then
.Range("I2:J" & Riadkov).Formula = Array("=H2-F2", "=ABS(I2)")
.Range("A1:J" & Riadkov).Sort Key1:=.Range("I1"), Order1:=xlDescending, Header:=xlYes
End If
End With
End Sub

Hmm, tiež neviem, čo presne potrebujete, tak možno len inšpirácia...

Funguje to. ALE ! V tých zošitoch sú linky na zdrojový zošit. Teda aj s cestou. Vy keď si urobíte kópiu toho celého adresára so zdrojom, aj so súbormi, tak to fungovať nebude, lebo tie súbory stále obsahujú cestu k pôvodnému umiestneniu. Tiež som si to neuvedomil, že tie Vaše súbory z prílohy tiež obsahujú Vašu pôvodnú cestu. Riešením na vyskúšanie, bez rizika poškodenia origo súborov je, že si urobíte zálohu celého origo adresára, z ktorej nebudete nič otvárať ani meniť. Makro vložíte do pôvodného origo adresára, kde sú aj správne cesty k linkom a spustíte. Pôvodnú origo verziu všetkých súborov dostanete, ak tú zálohu nakopčíte na pôvodné miesto. Bez rizika.
Vyskúšajte toto, rozbalte to priamo do C:\ nech sa nám zhodujú foldre. Zmente hodnoty v hlavnom, použite makro. Zatvorte hlavný a zmente mu názov napr. na "zdroj2.xlsm". Premiestnite ABC niekde inde napr. na kľúč, a otvorte. Hodnota bude zmenená. Ale link bude na pôvodný súbor v C:\, len ho nenájde a nechá poslednú známu hodnotu (ak nieje nastavený Excel inak).

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse