Příspěvky uživatele

Určite na to potrebujete makro ?
Takto to funguje, tak ako chcete, nie ?
Skúste ten adresár presunúť, a otvoriť zošit odtiaľ, normálne sa bude odkazovať na súbory v aktuálnom umiestnení.

Nehovorili ste pred tým, že listy budú číslované od "1" ? Teraz Vám to čísluje od 6. listu, nie od listu "6". Vaša posledná príloha absolútne nekorešponduje s tým kam pristupuje tento kód (riadky, stĺpce). Bez aktuálnej prílohy a podľa možnosti celého makra, sa radí naozaj veľmi zle.
Čo by som vám, ale poradil aj takto z brucha je:
-na začiatku kódu
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
-na konci kódu
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Ďalej by som použil konštrukciu
With
...
End With, tam kde sa Vám opakujú prístupy na rovnaký objekt, napr. :
Sheets(4 + 2 * u)
Sheets(5 + 2 * u)
Do With môžete zjednodušiť iba jednu stranu rovnice, musíte sa rozhodnúť ktorú.

Alebo, by som použil polia. Deklarácia
Dim Sml()
Na začiatku cyklu i by som dal načítať všetky údaje, aj tie ktoré sa nepoužijú.
Sml = Sheets("seznamsmluv").Cells(4 + i, 1).Resize(1, 13).Value 'udaje
a zápis by bol napr. pre:
Sheets("seznamsmluv").Cells(4 + i, 1)
Sheets("seznamsmluv").Cells(4 + i, 6)
Sheets("seznamsmluv").Cells(4 + i, 5)
takýto
Sheets(5 + 2 * u).Cells(1 + j, 1).Resize(1, 3) = Array(Sml(1, 1), Sml(1, 6), Sml(1, 5))
a pre
Sheets(4 + 2 * u).Cells(12, 4) = Sheets("seznamsmluv").Cells(4 + i, 13)
Sheets(4 + 2 * u).Cells(12, 5) = Sheets("seznamsmluv").Cells(4 + i, 9)
by som dal
Sheets(4 + 2 * u).Cells(12, 4).Resize(1, 2) = Array(Sml(1, 13), Sml(1, 9))

Ďalej by som ešte znížil počet volaní bunky
Cells(4 + i, 1)
a nahradil
C = Cells(4 + i, 1)
a použil iba C
Opakujem, že to dávam z brucha, keďže nieje príloha, ani začiatok a koniec procedúry, navyše aj tá asi nieje kompletná, je tam jedno prázdne else. Nevidíme data, nevidíme "číslovanie" listov, a už vôbec nevidím žiadnu blbuvzdornosť. Čo ak niekto premenuje list, alebo prehodí poradie ? Je šanca, že sa niečo také udeje ? Vytvárate tam niekde listy ? Ak nie, čo sa udeje, ak bude viac dát ako listov ?...

Čiastočne som tomu prišiel na kĺb:
Vyššie spomínaná chyba sa po týždňovej pauze, keď som sa teraz k tomu vrátil neobjavuje.

kp57 mi dal ešte nápad, či by nepomohlo vytvorenie privátneho certifikátu napr. podľa tohto
http://www.howto-outlook.com/howto/selfcert.htm
ale neviem posúdiť, keďže chyba zmizla skôr ako som to vyskúšal.

Ak Vám stačí posielať mail z mailového konta č. 1, tak môžete použiť
Dim OutApp As Object
Dim OutMail As Object
Ak ale máte v Outlooku niekoľko mailových kont, a chcete posielať z iného, treba použiť
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
To ale môžete použiť iba v prípade, že najskôr pridáte vo VBA - Tools - References - Microsoft Outlook 15.0 Object Library.
Je to potrebné pre to, aby ste mohli použiť číslo konta
.SendUsingAccount = OutApp.Session.Accounts.Item(From)
Pre vloženie Hypertextového odkazu bude potrebné použiť HTMLBody namiesto Body, kde bude ale pravdepodobne potrebné používať HTML značky, ako v kóde HTML stránky.
.HTMLBody = "text v maile" & "<br />" & "<a href=""http://www.google.com"">Google</a>"
Aby ste najskôr iba videli ako bude mail vyzerať zmente
.Send
na
.Display
nič sa neodošle, iba Vám zobrazí správu.

Celý kód:
Sub SendMail()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim Sender As String, From, i As Byte
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Sender = "odkoho@odkoho.sk"
On Error Resume Next
For i = 1 To OutApp.Session.Accounts.Count
If OutApp.Session.Accounts.Item(i) = Sender Then From = i: Exit For
Next i
If From = 0 Then
MsgBox ("Odosielateľ " & Sender & " v Outlooku neexistuje.")
GoTo Koniec
End If
With OutMail
.To = "komu@komu.sk"
.CC = ""
.BCC = ""
.Subject = "skúška"
.HTMLBody = "text v maile" & "<br />" & "<a href=""http://www.google.com"">Google</a>"
.SendUsingAccount = OutApp.Session.Accounts.Item(From)
.Send
End With
Koniec:
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Ale mám zatiaľ nevyriešený problém. A to je potreba odkliknúť povolenie pre odoslanie mailu "aplikáciou v zastúpení" Outlooku, čiže makrom. Neviete ako by sa to dalo vyriešiť ?

Napr.:
Sub CopyTo()
Dim X As Long, Y As Long
Application.ScreenUpdating = False
X = 3
Y = 4
Selection.Copy
With ActiveSheet
.Cells(ActiveCell.Row, ActiveCell.Column + X).Select
.Paste
.Cells(ActiveCell.Row, ActiveCell.Column + Y).Select
.Paste
.Cells(ActiveCell.Row, ActiveCell.Column + Y).Select
.Paste
.Cells(ActiveCell.Row, ActiveCell.Column + Y).Select
.Paste
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

alebo

Sub CopyTo2()
Dim X As Long, Y As Long
Application.ScreenUpdating = False
X = 3
Y = 4
With Selection
.Copy Destination:=Cells(ActiveCell.Row, ActiveCell.Column + X)
.Copy Destination:=Cells(ActiveCell.Row, ActiveCell.Column + Y + X)
.Copy Destination:=Cells(ActiveCell.Row, ActiveCell.Column + Y + Y + X)
.Copy Destination:=Cells(ActiveCell.Row, ActiveCell.Column + Y + Y + Y + X)
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Ako vždy :
čím novší - tým "lepší"

PS: Hovorím hlavne o Win, pretože toto je špecifikum W8/W8.1/W8.1.1 (a stavím krk na to, že aj W10). Často programy ani nedokážu zapísať svoj súbor, bez spustenia ako Správca (Administrátor nestačí).

Ale ak by sa našlo riešenie aj pre moju novšiu a "lepšiu" kombináciu, nebudem sa hnevať ani ja, pretože uvažujem o implementácii niečoho takéhoto do svojej aplikácie.

Ja som Vám to urobil takto

Do D43 zadajte
=IF(NUMBERVALUE(D42)>5;D42-5;"")
a pretiahnite tento vzorec aj do bunky pod ňou (D44).

Teraz do D42 zapíšte hodnotu napr. 11.
Dostanete výsledok:
11
6
1
Má to byť takto ?

Ak by to náhodou malo byť, tak, že v bunke D42 bude vypočítavaná hodnota vzorcom, a jeho výsledok bude 11, ale Vy tam chcete max 5, teda takto:
5
5
1
Tak to treba urobiť inak, ale podmienkou je, že D42 musí byť vypočítavaná. Zadávanej hodnote ručne do D42 to nieje možné, pretože bez makra nieje možné meniť tú istú bunku aj ručne aj vzorcom.

Napadá ma pár možností, ale či je to to, čo chcete ...

Nech sa páči. Porovnanie dvoch nerovnakých matíc s výpisom iba zhodných prvkov. Zoradené za sebou. Podmienené formátovanie, je tu ale iné, čo je logické, lebo v jednej aj druhej tabuľke môžu byť zafarbené adekvátne údaje inak. Takže v tejto poslednej sú podfarbené len tie, ktoré majú rovnaké podfarbenie v oboch tabuľkách.

PS: Inak minule som Vám tam dal o jeden stĺpec menej. Opravené. Čo nekričíte ?

Na W8.1 a Office 2013 x64 to končí chybou hneď na
Set OutApp = CreateObject("Outlook.Application")
vyžaduje práva správcu.
Na akom Win a Office Vám to funguje ?

Ešte som Vám tam doplnil aby Vám podmienene formátovalo aj výsledky. Ak by som bol na Vašom mieste, a bolo by to možné (existujú rôzne dôvody), tak by som si zmenil farby v podmienenom formátovaní na menej krikľavé.

@eLCHa
Tak toto je perfektné riešenie ! Načo taký komplikovaný vzorec, keď toto je elegantné. Len by som Vám ho doplnil o kontrolu tej SPZ (prvé 3 znaky obsahujú písmeno, vtedy nič nerobiť), a kontrolu chyby. To je ale všetko banalita, vzorec nemá chybu.
=IF(ISERROR(LEFT(A6;3)*1);"";IFERROR(MID(A6;MAX(IFERROR(FIND(ROW($A$1990:$A$2100);A6);0));4)/1;""))

@Alfan
Toto je presne riešenie aké potrebujete, a je jedno, či je to to isté ako v inom vlákne (neštudoval som).

Takto ?
Je tam aj podmienené formátovanie:
-oranžová na <-75%
-žltá na >75%
-žltá na prvý stĺpec výsledku, ktorý obsahuje nejaké prekračujúce hodnoty

Ďalej je použitá už matica, kvôli tomu aby boli za sebou (pozor vzorce sú až po stĺpec BG)

To chcete vypísať rovno v tých tabuľkách ? Čiže napr. ak upravíme vzorec v C4 z
=CORREL(usd!N3:N43;usd!F3:F43)
na
=IF(OR(CORREL(usd!N3:N43;usd!F3:F43)<=-75%;CORREL(usd!N3:N43;usd!F3:F43)>=75%);B4;CORREL(usd!N3:N43;usd!F3:F43))
tak rovno v C4 bude "AUDUSD", a rovnako bude "AUDUSD" aj v jej dvojíčke v E2?
Takto ? Ak áno, tak Vám spravím makro ktoré Vám prevedie tie vzorce na tento tvar (jednorázovo, žiadne makro potom používať nemusíte).
Ak som úplne mimo, tak to bude treba zoširša vysvetliť, pretože z finančníctva viem akurát to, že ma z neho bolí hlava

.

EDIT: OK, beriem všetko naspäť, už som to asi pochopil, že ide o to, čo je vpravo. Pôjdem sa na to mrknúť...

To si máme ten súbor podľa obrázku vytvoriť, vymyslieť zdroj dát, uhádnuť vzorce či podmienky, odhadnúť formátovanie, a potom určiť príčinu, následne aj riešenie ?
No na Vašom mieste by som zvážil prílohu...

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje