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

Příspěvky uživatele

Na víkend som si naplánoval jeden deň voľno, tak keď mi to vyjde, môžem sa Vám na to mrknúť. Nič ale nesľubujem...

-V prvom rade si pozrite, či nemáte zlé adresovanie názvu listov.
-Ak máte podozrenie, že Vám nejaké makro mení bunky, v danom liste si dajte BreakPoint do OnChange, a ďalej krokujte, aby ste videli, kam sa vráti.
-Ak používate globálne makro pre celý zošiť, pozrite či nemá tento list svoje makro v metóde onchange, lebo to je nadradené globálnemu.

Napr.

Je to vždy 90% z predošlého čísla. Čiže násobiť 0,9.
Takže si do dajte
A1 = 1000
A2 = A1*0,9
bunku A2 potiahnite koľko potrebujete.

Tak to Vás sklamem. Nič nezabráni úprave, ak dotyčný chce a má snahu či nejaký úmysel, o to očividne má. Tak ako to Vy prevediete na obrázky, tak si to on prevedie späť na text pomocou OCR.
S prevodom na obr. ale skúsenosť nemám...

Zadajte do Google "pdf unlocker" a hneď 1. odkaz je free online unlocker.

@ spitffire: Títo 2 páni by Vám to asi urobili peknejšie, ale toto máte odo mňa na dobrú noc :)
Sub Copy_1_To_3_Columns()
Dim P, D(), x As Integer, y As Long, r As Long, s As Integer
With Worksheets("List1")
r = .Cells(Rows.Count, 1).End(xlUp).Row
P = .Cells(1, 1).Resize(r)
End With
s = r \ 3
ReDim D(1 To s + 1, 1 To 3)
For y = 0 To s
For x = 1 To 3
If (y * 3) + x <= r Then D(y + 1, x) = P((y * 3) + x, 1)
Next x
Next y
With Worksheets("List2")
.Columns(1).ClearContents
.Cells(1, 1).Resize(s + 1, 3).Value = D
End With
End Sub

Čo prosím ? Ak myslíte úvodzovky ktoré ohraničujú textový reťazec, tie tam v skutočnosti niesú, to len symbolizuje že hodnota je reťazec. Ak reťazec skutočne obsahuje uvodzovky tak ich uvedený príkaz musí odstrániť. Vyskúšajte, čo Vám dá
ASC(Left(nazev, 1))

Akurát som našiel jeden kódik, už ho sem dám...
Private Sub SaveRngAsJPG(Rng As Range, FileName As String)
Dim Cht As Chart, bScreen As Boolean, Shp As Shape
bScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
Set Cht = Workbooks.Add(xlChart).Charts(1)
Cht.ChartArea.Clear
Rng.CopyPicture xlScreen, xlPicture
Cht.Paste
With Cht.Shapes(1)
.Left = 0
.Top = 0
.Width = Cht.ChartArea.Width
.Height = Cht.ChartArea.Height
End With
Cht.Export FileName, "JPEG", False
Cht.Parent.Close False
Application.ScreenUpdating = bScreen
End Sub

Sub TestIt2()
Dim Rng As Range, Fn As String
Set Rng = ThisWorkbook.Worksheets("Hárok1").Range("A1:D3")
Fn = "d:\MyFile.jpg"
SaveRngAsJPG Rng, Fn
End Sub
PS: Vo Win8 sú problematické práva pre disk C, ukladajte radšej inde. Bolo by treba ale ešte doriešiť nastavovanie rozmerov, bo malé rozsahy sú deformované.

EDIT: @tarantula222 : Tieto kódy sú nespoľahlivé. Aj ten Váš mi zastaví na
.Pictures.Paste.Select
Ak dám pokračovať, pekne dobehne...

AU
Wiki : 149597870700000 mm
Google : 149600000000000 mm

To vozítko Google to zase odfláklo.
stočtyřicetdevět=bilionů=pětsetdevadesátsedm=miliard=osmsetsedmdesát=milionů=sedmset=tisíc=milimetrů

Keď do toho ale vnesieme, že je to iba priemerná vzdialenosť, a šábneme to zakrivením časopriestoru, no ... niekto to bude musieť premerať mikrometrom

Toto Vám urobí hromadné kopírovanie viac obrázkov naraz. Nastavenie pozície sa už potom musí logicky robiť samostatne. Či je to rýchlejšie alebo nie, neviem, rýchlosť som netestoval ...
Sub Obrazky3()
Dim Img() As String, Data(), Vyber() As Integer, i As Integer, a As Integer, r As Integer, Pocet As Integer
With Sheets("Sekce")
Data = .Cells(4, 24).Resize(41, 5).Value
Pocet = WorksheetFunction.CountIf(.Range("X4:X44"), "<>" & "")
End With
ReDim Img(1 To Pocet): ReDim Vyber(1 To Pocet)
Application.ScreenUpdating = False
On Error Resume Next
For i = 4 To 44
If Not IsEmpty(Data(i - 3, 1)) Then
a = a + 1: Img(a) = Data(i - 3, 2): Vyber(a) = i - 3
End If
Next i
Sheets("Sekce").OLEObjects.Item(Img).Copy
With Sheets("Skladba jednotky")
.Paste
a = .OLEObjects.Count
For i = a - Pocet + 1 To a
r = i - (a - Pocet)
With .OLEObjects(i)
.Top = Data(Vyber(r), 3)
.Left = Data(Vyber(r), 4)
.Name = Data(Vyber(r), 5)
End With
Next i
End With
If Err Then MsgBox ("Počas operácie nastala chyba.")
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub Obrazky()
Dim Data()
Data = Sheets("Sekce").Cells(4, 24).Resize(41, 5).Value
Application.ScreenUpdating = False
On Error Resume Next
With Sheets("Skladba jednotky")
For i = 4 To 44
If Not IsEmpty(Data(i - 3, 1)) Then
Sheets("Sekce").OLEObjects.Item(Data(i - 3, 2)).Copy
.Paste
With .OLEObjects(.OLEObjects.Count)
.Top = Data(i - 3, 3)
.Left = Data(i - 3, 4)
.Name = Data(i - 3, 5)
End With
End If
Next i
End With
If Err Then MsgBox ("Počas operácie nastala chyba.")
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Koľko sa Vám ich naraz väčšinou kopíruje? Rozmýšľam, či by sa to nedalo hromadne kopírovať, či by sa neušetril nejaký čas ...

V dokonalom svete by ocinko mohol napr dostať riešenie s vychytávkami ako
- skryté kópie listov s pôvodnými dátami, a výpis aj pôvodných hodnôt
- výpis hodnôt všetkých zmenených buniek, nielen prvej v zmenenej oblasti (kopírovanie, mazanie, vypĺňanie)
- ošetrenie nesúvislého výberu (Areas)
...

Tiež sa často snažím urobiť All-In-One, ale len preto, aby som dodatočne dostával čo najmenej ďalších otázok a problémov. To všeobecne, nielen Excel.

Na námet od vovka.h som tam ešte pridal toto. V tomto prípade to nenastane, ale ošetril som tam pre ukážku aj možnosť rozdielu viac dní ako 31.

A ešte podotázka zo zaujímavosti: Dal by sa ešte najako inak získať počet minút?
Napr.
=RIGHT(TEXT(ABS(B2-B1);"h:mm");2)*1
=ZPRAVA(HODNOTA.NA.TEXT(ABS(B2-B1);"h:mm");2)*1
alebo
=MINUTE(ABS(B2-B1))
=MINUTA(ABS(B2-B1))
ale nejak lepšie by to nešlo?

Tak jednoduché počítanie to nieje. Ono totiž prevod na dni, hodiny, minúty hádže občas "zaujímavé" hodnoty. Ak nejaký čas odpočítate, zaokrúhli sa Vám niekde nejaká miliardtina, ak výsledok zobrazíte v bunke dá Vám často celé číslo (aj keď nieje), ale v ďalších sčítaniach to bude robiť nezrovnalosti. Viď vlákno Výpočty s dátumom a časom
Nemôžete ani stále pričítať nejaké číslo napr. +0,5 aby ste to potom dole zaokrúhlil, lebo pri zápornom čísle to +0,5 bude opačný problém. Tam som to vyriešil prepočtom času na dostatočne malé čiastky (tisíciny sekundy) a prirátaval +1, a z toho odsekol celú časť. Mrknite sa na to, možno nájdeme niečo sofistikovanejšie.

EDIT: Prílohu som vložil omylom do inej témy. Takže, mohlo by to byť takto ?

Alebo to ešte aj trochu zrýchlite a ošetrite:
Sub Obrazky()
Dim Data()
Data = Sheets("Sekce").Cells(4, 24).Resize(41, 5).Value
Application.ScreenUpdating = False
On Error GoTo POKRACUJ
With Sheets("Skladba jednotky")
For i = 4 To 44
If Not IsEmpty(Data(i - 3, 1)) Then
Sheets("Sekce").OLEObjects(Data(i - 3, 2)).Copy
.Paste
With .OLEObjects("image1")
.Top = Data(i - 3, 3)
.Left = Data(i - 3, 4)
.Name = Data(i - 3, 5)
End With
End If
Next i
POKRACUJ:
End With
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Je to napísané len tak z brucha, nemám na čom vyskúšať, a vymýšľať sa mi nechce :)

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse