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

Příspěvky uživatele

V novom Office to urobíte ľahko aj vzorcom:
=INDEX(B2:B55;TRANSPOSE(SEQUENCE(9;6)))
=INDEX(B2:B55;TRANSPOZICE(SEQUENCE(9;6)))
Makro napríklad:
Sub Rozdel()
Dim D(), V(), r As Long, s As Long, i As Long

With Worksheets("Data")
D = .Range("B2:B55").Value2
ReDim V(1 To 6, 1 To WorksheetFunction.RoundUp(UBound(D, 1) / 6, 0))
s = 1

For i = 1 To UBound(D, 1)
r = r + 1
If r = 7 Then s = s + 1: r = 1
V(r, s) = D(i, 1)
Next i

.Range("H2").Resize(6, UBound(V, 2)).Value2 = V
End With
End Sub

Mrkvosoft píše ...

Na nete som našiel, že Google túto službu zrušil po mnohých rokoch od oznámenia, že ju zruší.
Jeden týpek poradil zmenu adresy, a je to funkčné. Vyskúšajte.
With .Pictures.Insert("https://api.qrserver.com/v1/create-qr-code/?size=150x150&data=" & Replace(TEXT, " ", "%20"))Link na popis parametrov.

Sorry, nebol som tu pár dní. Urobil som Vám tam podrobný popis, ako to funguje, odôvodnil prečo sú tam kontroly, pridal som odchyt chýb čo ma napadli, že by mohli nastať, a snáď sprehľadnil kód.

Omrknite.

PS: Neviem načo sú tam tie ďalšie definované názvy, ale Body_5001 na konci chýbajú 2 riadky (lebo ostatné Body to tam majú).

=IF(Vzor!A4="";"";HYPERLINK("mailto:"&Vzor!C4;Vzor!C4))
=KDYŽ(Vzor!A4="";"";HYPERTEXTOVÝ.ODKAZ("mailto:"&Vzor!C4;Vzor!C4))
+ modrý a podčiarknutý font ?

Táto úprava urobí UTF-16 LE BOM, len v E2003 sa musí urobiť export do TXT a následne premenovať na ZAP. V E2024 to ide rovno to ZAP.
Upravil som aj rozhasené podm. formátovanie.

Neprišiel som na to, prečo sa za použitú oblasť považujú všetky stĺpce (256) akonáhle sa skryjú, no iba v tých prvých 3 listoch. Inde sú tiež skryté, ale ako použitá oblasť je iba skutočne použitá. Skúšal som aj vytvoriť znovu listy, vytvoriť kopírovaním z tých čo sú OK, ale vždy to dopadne rovnako. Zdá sa mi, že to neúmerne zväčšuje súbor.

@pepča: ak by Vám hneď nepadlo do oka, o čom tu s "veny" píšeme, tak je to práve oblasť $H$1:H1 vs $U$1:$U1. Teda to je stĺpec, v ktorom máme už ten vzorec, len iba po riadok vyššie. Teda hľadáme (0) ktoré ešte nemáme v našom stĺpci. Preto tam musí byť tá 1. bunka ako hlavička (nevyskytujúca sa v prehľadávaných hodnotách).

@veny: to asi nie

Pr.

-Jedná sa tam vždy iba o číselné hodnoty? Teda nie je v exporte text s diakritikou?
-Výsledné kódovanie textového súboru ZAP musí byť UTF-16 LE BOM?
-Desatiny sú v exporte vždy na 4 desatinné miesta?
-Desatinný oddeľovač v exporte je bodka "." ?
-"výška stroje/cíle" je vždy "0.0000" alebo je ten stĺpec určený na manuálne dopisovanie.

Pýtam sa to všetko preto, lebo tak ako to robíte, by som to určite nerobil.

Príklad:

Príloha nejde stiahnuť, skúste ju priložiť ešte raz.

Neviem, ktorý mail myslíte. Jeden používate ako príjemcu, a druhý ako príjemcu kópie a príjemcu skrytej kópie.
Ak prvý, tak si zmeňte iba
.To = ThisWorkbook.Worksheets("List2").Range("A1")a
.Subject = Format(Date, "DD.MM.YYYY") & " - " & WS.Range("A3")

2 varianty. Ak Vám nie je jasný rozdiel, píšte.
Sub a()
Dim xOutApp As Object
Dim xOutMail As Object
Dim WS As Worksheet

ThisWorkbook.Save

On Error Resume Next
Set xOutApp = GetObject(, "Outlook.Application")
On Error GoTo 0

If xOutApp Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
End If
Set xOutMail = xOutApp.CreateItem(0)
Set WS = ThisWorkbook.ActiveSheet

On Error Resume Next

With xOutMail
.To = WS.Range("A1")
.CC = WS.Range("A2")
.BCC = WS.Range("A2")
.Subject = WS.Range("A3")
.Body = xMailBody
.Attachments.Add ThisWorkbook.FullName
.Display 'or use .Send
End With

If Err.Number <> 0 Then
MsgBox "Pri odosielaní mailu došlo k chybe !", vbCritical
End If

On Error GoTo 0

Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

Sub b()
Dim xOutApp As Object
Dim xOutMail As Object
Dim WS As Worksheet
Dim tmpFile As String

tmpFile = Environ$("temp") & "\" & ThisWorkbook.Name
ThisWorkbook.SaveCopyAs tmpFile

On Error Resume Next
Set xOutApp = GetObject(, "Outlook.Application")
On Error GoTo 0

If xOutApp Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
End If
Set xOutMail = xOutApp.CreateItem(0)
Set WS = ThisWorkbook.ActiveSheet

On Error Resume Next

With xOutMail
.To = WS.Range("A1")
.CC = WS.Range("A2")
.BCC = WS.Range("A2")
.Subject = WS.Range("A3")
.Body = xMailBody
.Attachments.Add tmpFile
.Display 'or use .Send
End With

If Err.Number <> 0 Then
MsgBox "Pri odosielaní mailu došlo k chybe !", vbCritical
End If

On Error GoTo 0

Kill tmpFile

Set xOutMail = Nothing
Set xOutApp = Nothing
Set WS = Nothing
End Sub

Option Explicit
To slúži na to, aby debuger kontroloval, či máte definované všetky premenné. Aby ste nepoužil nedefinovanú premennú.

TimeValue("00:00:01")
TimeSerial(0, 0, 1)
je to isté, len jedno dá sekundu času z textového času, a druhé čísel jednotlivých zložiek času (hod, min, sek)

Menej ako sekunda? To je informačné okno, načo tam potrebujete desatiny, to nie sú stopky. Ak požadujete presnejší timer, tak treba použiť ďalšie API a systémový timer, ale s tým je problematická práca. Nesmiete pri ňom debugovať alebo pozastaviť makro, spadne Excel.

Tak?

Napr. do A1 vzorec, A1 natiahnuť po D1, A1:D1 natiahnuť na požadovanú výšku:
=IFERROR(INDEX(data!$A$1:$B$7;(ROW(A1)-1)*2+IF(COLUMN(A1)>2;2;1);2-MOD(COLUMN(A1);2));"")
=IFERROR(INDEX(data!$A$1:$B$7;(ŘÁDEK(A1)-1)*2+KDYŽ(SLOUPEC(A1)>2;2;1);2-MOD(SLOUPEC(A1);2));"")

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse