Příspěvky uživatele

Veď to je plne dynamické. Som počítal, že si to upravíte ako ste vravel.
Takže príklad (dá sa napchať aj do 1 riadku):
Sub pokus()
Dim R As Long, PR As Long, PS As Integer, S As Integer, ADR As String

R = 10 'prvý riadok
S = 4 'prvý stĺpec
PR = 200 'počet riadkov
PS = 1 'počet stĺpcov
ADR = Cells(R, S).Resize(PR, PS).Address 'Adresa
Range(ADR).Value = Evaluate(Replace("=IF(?<>"""",ROUND(?,2),"""")", "?", ADR)) 'Vo vzorci sa za ? nahradí adresa
End Sub

EDIT:
Prípadne by som to upravil ešte pomocou IFERROR, pre prípad, že by tam bol aj text:
Range(ADR).Value = Evaluate(Replace("=IFERROR(IF(?<>"""",ROUND(?,2),""""),?)", "?", ADR)) 'Vo vzorci sa za ? nahradí adresa

Range("D10:D200").Value = Evaluate("=IF($D$10:$D$200<>"""",ROUND($D$10:$D$200,2),"""")")

Tak testujte o 1 podmienku menej. Ak to dobre chápem, tak stačí otestovať či je I1 v tom inom zošite číslo a zároveň ak je, tak či je väčšie ako P2 a aktuálnom liste aktuálneho zošitu. Ak je splnená táto dvojpodmienka tak hodnotu I1 v inom zošite nahradiť tou z P2 z aktuálneho listu aktuálneho zošitu. Ale nahradí to aj keď bude I1 obsahovať "abc" alebo iný text ako "Nejsou data", teda akýkoľvek. Neviem, čo môže I1 nadobúdať.

Sub pokus()
Dim JmenoS As String, Rok As String, Nahradna As Double, Hodnota

JmenoS = "Zošit1"
Rok = "Hárok1"
Nahradna = Range("P2").Value
With Workbooks(JmenoS).Worksheets(Rok).Range("I1")
Hodnota = .Value
If IsNumeric(Hodnota) And Hodnota > Nahradna Then MsgBox "kuk" Else .Value = Nahradna
End With
End Sub
Ale máte pravdu v tom, že sa tým netreba zaoberať, či ide o 1 alebo 2/1000 sek je šumák. To len tak z nudy...

Myslíte test, či v bunke je text "Nejsou data", alebo chcete otestovať či je bunka prázdna niečim podobným:
IsEmpty(Workbooks(JmenoS).Worksheets(Rok).Range("I1"))
LenB(Workbooks(JmenoS).Worksheets(Rok).Range("I1"))=0
Workbooks(JmenoS).Worksheets(Rok).Range("I1").Value=""

Tag je vlastnosť niektorých objektov, a dá sa použiť práve v takomto prípade, ak chcete preniesť nejakú hodnotu cez stály objekt medzi procedúrami. Použil som to z minimalistického hľadiska, namiesto globálnej premennej.
Ostatné veci sú len úpravy Vašeho kódu, napr. kontrola objektu Outlook (načo vytvárať ďalší, keď je spustený), odchyt chyby pri otváraní obrázku, či odoslaní mailu. No a dal som tam ten spomínaný zápis cez pole, naraz. Ak by som vedel čo je v stĺpcoch 9 a 10, možno by sa dalo to celé urobiť naraz aj s cestou k obrázku. Inak hyperlink je jednoduchý, namiesto
.Cells(FirstEmptyRow, 11).Value = Image1.Tag
dajte
If LenB(Image1.Tag) > 0 Then
.Cells(FirstEmptyRow, 11).Value = Image1.Tag
.Hyperlinks.Add Anchor:=.Cells(FirstEmptyRow, 11), Address:=Image1.Tag
End If
Doplnené do predošlého príspevku s kódom a aj v prílohe.

Príklad úpravy
Private Sub cmbNahratFoto_Click()
Dim ImageLocation As String

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Images", "*.bmp; *.jpg; *.jepg; *.png; *.tif", 1
If .Show = -1 Then ImageLocation = .SelectedItems(1)
End With
If ImageLocation <> "" Then
With Image1
.Tag = ImageLocation
On Error GoTo ERROR
.Picture = LoadPicture(ImageLocation)
.PictureSizeMode = fmPictureSizeModeStretch
End With
End If
Exit Sub
ERROR:
MsgBox "Při načítání obrázku došlo k chybě !", vbExclamation
End Sub
Private Sub btZapisTPM_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim FirstEmptyRow As Long
Dim aZapis(7)
Const PW As String = "heslo"

'Nastavení pole zápisu hodnot
aZapis(2) = Now
aZapis(3) = Application.UserName
aZapis(4) = txbPopisZavady.Text
aZapis(5) = cbxZodpovednost.Text
aZapis(6) = cbxMisto.Text
aZapis(7) = cbxPatro.Text

With ThisWorkbook.Worksheets("TPM")
FirstEmptyRow = .Cells(Rows.Count, 2).End(xlUp).Row + 1

aZapis(0) = .Cells(FirstEmptyRow - 1, 1).Value
If IsNumeric(aZapis(0)) Then aZapis(0) = aZapis(0) + 1 Else aZapis(0) = 1
aZapis(1) = .Cells(FirstEmptyRow - 1, 2).Value
If IsNumeric(aZapis(1)) Then aZapis(1) = aZapis(1) + 1 Else aZapis(1) = 1

Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

.Unprotect PW
ThisWorkbook.Unprotect PW
'Zápis hodnot
.Cells(FirstEmptyRow, 1).Resize(, 8).Value = aZapis
If LenB(Image1.Tag) > 0 Then
.Cells(FirstEmptyRow, 11).Value = Image1.Tag
.Hyperlinks.Add Anchor:=.Cells(FirstEmptyRow, 11), Address:=Image1.Tag
End If

.Protect PW
ThisWorkbook.Protect PW

Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End With

Unload TPM

''EMAIL
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
Err.Clear
If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
If cbxZodpovednost = "Údržba" Then
.to = "email"
ElseIf cbxZodpovednost = "Správce budov" Then
.to = "email"
End If
.CC = ""
.BCC = ""
.Subject = "Nové TPM"
.Body = "Máte nové TPM - pro přehled všech TPM navštivte adresu"
.Attachments.Add ThisWorkbook.FullName
.Send 'or use .Display
End With

If Err.Number <> 0 Then MsgBox "Chyba pri vytváření mailu.", vbExclamation
On Error GoTo 0

Set OutMail = Nothing: Set OutApp = Nothing
End Sub

Veď predsa tú cestu k obrázku musíte mať v nejakej premennej, veď ju načítavate cez LoadPicture(cesta) do Image1. No tak tú premennú uložte. Akú inú cestu k obrázku potrebujete, ako tú, čo už máte. Vytvorte si vo Forme globálnu premennú a do nej uložte cestu k obrázku v procedúre toho načítavacieho buttonu, a potom túto globálnu premennú s cestou budete mať dostupnú aj procedúre ukladacieho buttonu.

Približne takto
Dim Cesta As String

Private Sub btnNahratFotografii_Click()
Cesta = "d:\Dokumenty\Obrázky\Avatar01.jpg"
Image1.Picture = LoadPicture(Cesta)
End Sub

Private Sub btnZapisTPM_Click()
wsDB.Cells(2, 11).Value = Cesta
End Sub

Ak tam potrebujete zároveň zapísať aj zodpovednosť, popis závady a ostatné do jedného riadku v DB, tak to cez pole pôjde na šupu. Ak ten Form máte otvorený na zápis viac ako 1 položky, tak pri vytváraní novej vynulujte premennú Cesta, a to preto, ak by mohla nastať aj situácia, že obrázok nebude vložený. Lebo by sa vložila pôvodná cesta.

Aj nematicovo:
=SUMPRODUCT(1/COUNTIF(A1:A6;A1:A6))
=SOUČIN.SKALÁRNÍ(1/COUNTIF(A1:A6;A1:A6))
prípadne cez FREQUENCY
=SUMPRODUCT(--(FREQUENCY(A1:A7;A1:A7)>0))
=SOUČIN.SKALÁRNÍ(--(ČETNOSTI(A1:A7;A1:A7)>0))
všetko z prvého odkazu na Google.

Tak nejak som tušil, že si to všimnete

Môže tam byť aj
"<>"
Ide len o to nejako to podmieniť, lebo maticové vzorce často treba podmienkou prinútiť k "zmaticoveniu".

Napr.: (maticový vzorec : Ctrl+Shift+Enter)
=MATCH(TRUE;SUMIF(OFFSET(C3;;;;COLUMN(C3:L3)-2);"<>somarina")>=A3;0)
=POZVYHLEDAT(PRAVDA;SUMIF(POSUN(C3;;;;SLOUPEC(C3:L3)-2);"<>somarina")>=A3;0)

Aha, tak! Toto opravené nikdy nebude. Nefunguje bohužiaľ ani systém 1904.

EDIT: Máte nejaký spešl dôvod ísť 120 rokov dozadu?

Čo znamená "chybně zobrazuje" ? Mne funguje normálne (Excel 2019). Priložte prílohu.

Lenže vy tam máte desatinné čísla (stĺpec C), ktoré ste skryl iba formátom. Excel s nimi samozrejme ďalej reálne počíta. Formát je iba na zobrazenie. Treba ich zaokrúhliť, napr. :
=INT(A1*B1-A1+0,5)
=CELÁ.ČÁST(A1*B1-A1+0,5)prípadne
=MROUND(A1*B1-A1;1)

EDIT: Ale pozor, nemôžete len tak hocikde vo výpočte zaokrúhľovať, len pre vizuál. To je vysoko individuálne, podľa druhu výpočtu. Niekde časti, inde celok. Nikto netuší, čo tie výpočty u Vás znamenajú.

Zaregistrujte sa, aby ste mohol priložiť prílohu, a priložte ju. Mne to príklad vydedukovaný z obrázku počíta správne. Ale nikto nevie čo tam máte za čísla, aký formát, zaokrúhlenie, ... (prílohu zbavte citlivých informácií)

??? Tak takúto prílohu som teda nečakal, navyše bez popisu súvislostí v nej

Tak si rozoberme najskôr technikálie:
Spodná ľavá tabuľka:
- prvé dva stĺpce sú PSČ od - do ?
- tretí stĺpec je zóna, vzťahujúca sa k hornej tabuľke k hlavičke C2:P2 ?

Horná tabuľka:
1 - 30 kg ??? A keď to bude 1/2 kg ? Podľa mňa to musí začínať 0 - 30 kg.
- Max 2751 - 3000 kg ? A čo ak bude viac ?

Dolná pravá tabuľka:
- G25:M26 - to je čo ? Začiatočné 2 čísla PSČ ? Koncové ?
- musia to byť zlúčené bunky ? S tým sa zle pracuje.
- Raz je tam rozsah, a inokedy "jedno alebo druhé". Toto bude nemenné ?
- Hmotnosť do 1000 kg ? Tá istá otázka, čo ak bude viac ?

objem "cbm":
Ako vstupuje do výpočtu ?

Vzorcami bude toto ťažké. Budem dôverovať mepexg-ovi, že Vás pochopil, a že to v PQ dal

EDIT: 21.06.2020 00:14
Tak skúsim...

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje