Příspěvky uživatele
< návrat zpět
Děkuji za ochotu, ale poslat to nemůžu. Je to poměrně obsáhlý soubor s databázemi a velkou hromadou kódu, kde jsou i citlivá data.
Zkusil jsem web4u, seznam a gmail (outlook nepoužívám).
Z nich se diakritika zobrazila správně jen na seznamu.
Koukal jsem na nastavení web4u (tam to potřebuju primárně funkční) a zobrazování je nastaveno na UTF-8. Zkoušel jsem změnit nastavení na Windows-1250 a ISO 8859-2. Stejný výsledek.
Žádný outlook. Používám CDO, obcházím poštovního klienta a přihlašuju se přímo k účtu na web4u. Mail se odesílá na pozadí, bez potvrzení klienta. Rozbitá diakritika je pak na cílovém účtu v HTML těle mailu.
Sub MailCDO(muser As String, mpass As String, mto As String, mcc As String, mbcc As String, mpredmet As String)
Dim iMsg As Object
Dim iConf As Object
Dim strBody As String
Dim Flds As Object
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1
Set Flds = iConf.Fields
strConf = "http://schemas.microsoft.com/cdo/configuration/"
With Flds
.Item(strConf & "sendusing") = 2
.Item(strConf & "smtpserver") = "smtp.web4u.cz"
.Item(strConf & "smtpserverport") = 25
.Item(strConf & "smtpauthenticate") = 1
.Item(strConf & "sendusername") = muser
.Item(strConf & "sendpassword") = mpass
.Update
End With
With iMsg
Set .configuration = iConf
.to = mto
.cc = mcc
.bcc = mbcc
.From = muser
.Subject = mpredmet
Dim strCestaSoubor As String
Dim strObsahHTML As String
strCestaSoubor = ActiveWorkbook.Path & "\temp.htm"
ActiveWorkbook.PublishObjects.Add(xlSourceSheet, _
strCestaSoubor, ActiveSheet.Name).Publish (True)
Set fso = CreateObject("Scripting.FileSystemObject")
Set txt = fso.GetFile(strCestaSoubor).OpenAsTextStream(1, -2)
strObsahHTML = txt.ReadAll
txt.Close
.HTMLBody = strObsahHTML
.send
End With
Set iMsg = Nothing
Set iConf = Nothing
End Sub
Zdravím.
Mám kód na převod listu do HTML a následné kopírování do těla mailu. Funguje správně, až na to, že zobrazuje špatně diakritiku. Celý list je naformátovaný jako text.
Prosím o radu, jak to opravit.
Dim strCestaSoubor As String
Dim strObsahHTML As String
strCestaSoubor = ActiveWorkbook.Path & "\temp.htm"
ActiveWorkbook.PublishObjects.Add(xlSourceSheet, _
strCestaSoubor, ActiveSheet.Name).Publish (True)
Set fso = CreateObject("Scripting.FileSystemObject")
Set txt = fso.GetFile(strCestaSoubor).OpenAsTextStream(1, -2)
strObsahHTML = txt.ReadAll
txt.Close
.HTMLBody = strObsahHTML
xlnc Díky. Pomohlo.
Nedaří se mi nastavit správně rowsource v comboboxu.
Mám 2 proměnné - které definují začátek a konec oblasti.
A ani zaboha se mi nedaří je dostat do rowsource.
Zkusil jsem to takto (a asi 10 dalšími způsoby) a nic.
Co dělám blbě?
Díky za jakoukoliv radu. Strávil jsem tím odpoledne a jsem zoufalý.
x.row = první řádek oblasti
y.row = poslední řádek oblasti
(msgboxy x.row a y.row dávají správná čísla)
s = sloupec
rowsource je závislý na změně obsahu comboboxu2, takže celý kód vč výpočtu proměnných je zapsán do comboboxu 2.Dim rng as Range
Set rng = Worksheets("AB").Range(Cells(x.row, s), Cells(y.row, s))
Combobox1.rowsource = rng
Tak nic, už jsem to vyřešil 
lastrow = Worksheets("Trasy").UsedRange.Rows(Worksheets("Trasy").UsedRange.Rows.Count).Row
Opět zdravím a otevírám toto téma, protože to není úplně OK.
Kód výše funguje velmi dobře. Z comandbuttonu jsem ho natáhl přímo do texboxů a comboboxů, s kritérii a vše šlape bezchybně.
Jediný problém je v délce zpracování, když do kritérií zadám:
- hodnotu, která není v dtb
- hodnotu která je v dtb, ale po filtrování jiným kritériem je skrytá
Pak je hodnota lastrow příliš vysoká (1 048 576) a následné procedury trvají cca minutu.
Zkoušel jsem přidat njaké podmínky, ale rozbil jsem tím filtrování na základě více kritérií - příliš mnoho chybových stavů k ošetření.
Napadá někoho, jak to vyřešit?
Díky
Odpovím si sám 
Tohle mi funguje dokonale a v listboxu zobrazí sloupců kolik chci. Už jen dořešit vícenásobné filtrování, filtrování rozsahu, ošetřit chybové stavy a je to. 
Private Sub CommandButton5_Click()
Dim rng As Range, r As Range
Worksheets("Trasy").Columns("A:Q").AutoFilter Field:=4, Criteria1:=ComboBox8.Value
lastrow = Worksheets("Trasy").Cells(1, 1).End(xlDown).Row
Set rng = Worksheets("Trasy").Range(Worksheets("Trasy").Cells(1, 1), Worksheets("Trasy").Cells(lastrow, 1))
Set rng = rng.SpecialCells(xlCellTypeVisible)
ReDim rTab(0 To rng.Count - 1, 1 To 13)
i = 0
For Each r In rng
rTab(i, 1) = r.Value
rTab(i, 2) = r.Offset(, 1)
rTab(i, 3) = r.Offset(, 2)
rTab(i, 4) = r.Offset(, 3)
rTab(i, 5) = r.Offset(, 4)
rTab(i, 6) = r.Offset(, 5)
rTab(i, 7) = r.Offset(, 6)
rTab(i, 8) = r.Offset(, 7)
rTab(i, 9) = r.Offset(, 8)
rTab(i, 10) = r.Offset(, 9)
rTab(i, 11) = r.Offset(, 10)
rTab(i, 12) = r.Offset(, 11)
rTab(i, 13) = r.Offset(, 12)
i = i + 1
Next
Me.ListBox1.List = rTab
End Sub
Tak jsem někde vyštrachal tento kus kódu a lehce si ho upravil:
Private Sub ComboBox8_Change()
Dim i As Long
Dim arrTrasy As Variant
With Worksheets("Trasy")
Me.ListBox1.Clear
If .Range("A" & .Rows.Count).End(xlUp).Row > 1 And Trim(Me.ComboBox8.Value) <> vbNullString Then
arrTrasy = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value2
For i = LBound(arrTrasy) To UBound(arrTrasy)
If InStr(1, arrTrasy(i, 1), Trim(Me.ComboBox8.Value), vbTextCompare) Then
Me.ListBox1.AddItem arrTrasy(i, 1)
End If
Next i
End If
If Me.ListBox1.ListCount = 1 Then Me.ListBox1.Selected(0) = True
End With
End Sub
To by šlo, kdybych měl v listboxu jeden sloupec. Jenže já jich tam potřebuju více.
A protože tomu kódu moc nerozumím, tak nevím, jestli jde upravit, aby se v listboxu objevily další sloupce.
Už ve svém předchozím příspěvku jsem přiložil soubor, kde jsou vzorce nastaveny.
Nevím, jestli jsem pochopi zadání správně.
Pokud hodnota v D2 > = 200, pak C2 = D2
Pokud ne pak C2 = "-"
Pokud chápu špatně, opravte mne.
Díky, už je to tam.
A sakra. Nepovolená přípona. Jsem tu nový, tak musím nejdřív přijít na to,jak sem nacpat přílohu :)
Zdravím.
Narazil jsem na své limity a potřeboval bych poradit od zkušenějších.
Jde o to, jak filtrovat data, zobrazovaná v listboxu.
V příloze je userform2 - editace tras. Nad listboxem je combo box, kde potřebuji vybrat položku. V listboxu pak potřebuji zobrazit jen řádky, kde je tato položka uvedena.
Je to podstatný prvek, bez kterého je celý projekt k ničemu. V dalších formulářích pak budu potřebovat filtrovat i podle datumu - od do.
Prosím o radu jak to nejlépe vyřešit.
Napadlo mne jen toto řešení - button ve form, který spustí autofiltr v listu s daty. Po opuštění formuláře se autofiltr zruší.
Problém je, že listbox pořád zobrazuje všechny řádky z dtb, bez ohledu na autofiltr.
Tak buď poraďte, jak donutit listbox zobrazovat pouze filtrovaná data z dtb, nebo nějaký způsob, jak donutit listbox filtrovat bez použití autofiltru.
Díky
Uživatelské menu
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
RSS nejnovější články