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

Příspěvky uživatele

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...

No nič, tak dám aspoň príklad...

Situácia bude podľa mňa riešiteľná chvíľku nato ako priložíte prílohu, nech si ju nemusíme vytvárať

Áno, ale aj tak musíte vždy vedieť čo hľadáte, lebo toto prehľadá OLE objekty (ActiveX), nenájde napr. ovál alebo klasické tlačítko, lebo to nie sú OLE.

A na novom Win je ten disk namapovaný ? Vidíte ten súbor v nejakom správcovi súborov (Prieskumník, Total Commander, ...) ? Ide Vám manuálne otvoriť ? Ak je odpoveď na všetko "áno", priložte makro.

Pre celý zošit:
Sub ChangesComboBoxesSettingBook()
Dim OLEObj As OLEObject, WS As Worksheet

Const CBID As String = "Forms.ComboBox.1"

For Each WS In ThisWorkbook.Worksheets
For Each OLEObj In WS.OLEObjects
If OLEObj.progID = CBID Then OLEObj.Object.Text = "pokus"
Next OLEObj
Next WS
End Sub

Pre jeden list:
Sub ChangesComboBoxesSettingSheet()
Dim OLEObj As OLEObject

Const CBID As String = "Forms.ComboBox.1"

For Each OLEObj In Worksheets("Hárok1").OLEObjects
If OLEObj.progID = CBID Then OLEObj.Object.Text = "pokus"
Next OLEObj
End Sub

@ marjankaj: Pravda, nevšimol som si, že som zamenil - za +

Dá sa na to použiť aj EVALUATE
Private Sub CommandButton1_Click()
Range("F3:F214").Value = Evaluate("=F3:F214+C3:C214")
End Sub
možno pre istotu aj s názvomlistu:
Private Sub CommandButton1_Click()
Range("F3:F214").Value = Evaluate("='" & Parent.Name & "'!F3:F214+'" & Parent.Name & "'!C3:C214")
End Sub
no a klasický postup cez cyklus:
Private Sub CommandButton1_Click()
Dim F(), C(), i As Long
F = Range("F3:F214").Value
C = Range("C3:C214").Value
For i = 1 To UBound(F, 1)
F(i, 1) = F(i, 1) + C(i, 1)
Next i
Range("F3:F214").Value = F
End Sub

Pre upresnenie - uviedol som to tučným písmo minule - priložte prílohu. Musím vidieť tie odkazy a umiestnenie, nemôžem si byť istý, či myslíte to čo píšete.
"Nějak mi to nejde" - to je popis chyby ? Hodí to chybu? Kde? Na ktorom riadku? Nestiahne správny obr? Nestiahne žiadny? ... Aká verzia a bitová kópia Excelu ...
#If VBA7 And Win64 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As LongPtr, _
ByVal lpfnCB As LongPtr _
) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long _
) As Long
#End If

Public Const ERROR_SUCCESS As Long = 0
Public Const BINDF_GETNEWESTVERSION As Long = &H10
Public Const INTERNET_FLAG_RELOAD As Long = &H80000000

Sub downloadImages()
Dim i As Long, sURL As String, sSubor As String, sCesta As String, aUrl() As String

sCesta = "d:\Download\Obr\"

For Each Bunka In Worksheets("Hárok1").Range("G2:G11297").Cells
sURL = ""
On Error Resume Next
sURL = Bunka.Hyperlinks(1).Address
On Error GoTo 0

If sURL <> "" Then
aUrl = Split(sURL, "/")
sSubor = sCesta & aUrl(UBound(aUrl))
URLDownloadToFile 0&, sURL, sSubor, BINDF_GETNEWESTVERSION, 0&
End If
Next Bunka
End Sub

Čítanie adresy z HL odkazu by som videl možno nejak takto (deklarácia rovnaká):
Sub downloadImages()
Dim i As Long, ret As Long, sURL As String, sSubor As String, sCesta As String
Dim aR() As Boolean, RC As Long, aUrl() As String

sCesta = "d:\Download\Obr\"

With Worksheets("Hárok1")
RC = .Cells(Rows.Count, "A").End(xlUp).Row - 1
If RC = 0 Then Exit Sub
ReDim aR(1 To RC, 1 To 1)

For Each Bunka In .Cells(2, 1).Resize(RC).Cells
i = i + 1
sURL = ""
On Error Resume Next
sURL = Bunka.Hyperlinks(1).Address
On Error GoTo 0

If sURL <> "" Then
aUrl = Split(sURL, "/")
sSubor = sCesta & aUrl(UBound(aUrl))
ret = URLDownloadToFile(0&, sURL, sSubor, BINDF_GETNEWESTVERSION, 0&)
aR(i, 1) = ret = 0
End If
Next Bunka
.Cells(2, 2).Resize(RC).Value = aR
End With
End Sub

Narýchlo:
Takže Vy chcete stiahnuť obrázky z webu? Zdroj kódu
#If VBA7 And Win64 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As LongPtr, _
ByVal lpfnCB As LongPtr _
) As Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long _
) As Long
Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long
#End If

Public Const ERROR_SUCCESS As Long = 0
Public Const BINDF_GETNEWESTVERSION As Long = &H10
Public Const INTERNET_FLAG_RELOAD As Long = &H80000000

Sub downloadImages()
Dim i As Long, ret As Long, sURL As String, sSubor As String, sCesta As String

sCesta = "d:\Download\Obr\"
With Worksheets("Hárok1")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
sSubor = sCesta & Split(.Cells(i, 1).Value, "/")(UBound(Split(.Cells(i, 1).Value, "/")))
sURL = .Cells(i, 1).Value
ret = URLDownloadToFile(0&, sURL, sSubor, BINDF_GETNEWESTVERSION, 0&)

If ret = 0 Then
.Cells(i, 3) = "File successfully downloaded"
Else
.Cells(i, 3) = "Unable to download the file"
End If
Next i
End With

End Sub
Priložte prílohu s príkladom.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse