Příspěvky uživatele
< návrat zpět
Navrhuji změnit jméno této skvělé stránky z Wall.cz na VlozPrilohu.cz
Protože tak začíná polovina odpovědí.
"Nemůžu ukázat, dělám s citlivými daty", to mě pokaždé dostane.
Jestli mám napsat nějaké makro, musím znát strukturu daného projektu a musím vědět co to makro má dělat.
Například:
Kdo a jak zakládá ty soubory "ceny.xls". Jaká je jejich struktura. Pracuje se nějak s nimi, nebo slouží jen jako úložiště dat. Nemohly by být například ukládány v textovém formátu (\*.txt \*.csv)?
Na to stačí vzorek takového sešitu (bez citlivých dat) a nějaké doplňující informace.
Jak vypadá prostředí, do kterého se má načítat. Co na čem závisí atd. Je už hotové, neměnné, nebo ho právě tvoříš a budeš ho ještě stokrát předělávat. Na to stačí vzorek takového sešitu (bez citlivých dat) a nějaké doplňující informace.
Já strávím večer psaním nějakého kódu, ty si ho nakopíruješ já nevím kam a pak mi odepíšeš, že to nic nedělá.
Pochop, že takhle ti nemůžu pomoct. Ty musíš ukázat na vzorovém sešitu (bez citlivých dat) jak to má vypadat.
Přikládám upravený vzorek, pro lepší představu.
No nejjednodušší by bylo, kdybys poslal ukázku tvého dokumentu.
Promiň, že se ptám, ale překopíroval jsi kód Funkce (WBAProject-Module1) do svého dokumentu?
A ještě poznámka: Funkce používá dost pomalou metodu "ExecuteExcel4Macro()", proto se nehodí pro načítání větších oblastí.
V takovém případě je lépe používat ADO, DAO, nebo GetObject().
Funkcemi Excelu se mi to nedaří, tak jsem zmastil za pomoci Googlu vlastní.
No vidíš, že to jde!
Případně taky:Sub soubory_2()
Dim Path_1 As String, Path_2 As String
Path_1 = "C:\test1"
Path_2 = "C:\test2"
Shell "xcopy " & Path_1 & "\*.pdf " & Path_2
End Sub
Nápovědu Excelu, nebo Help VBA?
Dim rdR As Long
For rdR = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If WorksheetFunction.CountA(Rows(rdR)) = 0 Then Rows(rdR).Delete
Next rdR
Předpokládám, že:Private Sub Workbook_Open()
Application.OnTime Date + 1 + TimeValue("00:12:00"), "SaveThis"
End Sub
Pak pokud není systém zaneprázdněný, spustí proceduru.
Ta podle nastavených parametrů proběhne, k opakování po minutě nevidím důvod.
V případě, že podle nastavených parametrů neproběhne, nastaví nový čas spuštění.Sub SaveThis()
If TimeValue(Now) <= TimeValue("00:14:00") Or TimeValue(Now) >= TimeValue("02:12:00") Then
Application.DisplayAlerts = False
Dim WB As Workbook
For Each WB In Workbooks
WB.Save
Next WB
ThisWorkbook.Saved = True
Application.DisplayAlerts = True
Application.Quit
Else
Application.OnTime Date + TimeValue("02:12:00"), "SaveThis"
End If
End Sub
No pokud nevadí makro, tak třeba:'ULOZI AKTIVNI LIST JAKO CSV
Sub UlozitJakoCSV()
Dim PathCSV As String, NameCSV As String, SepCSV As String
Dim MyStr As String, xFile As Byte
Dim rdR As Long, rdFirst As Long, rdLast As Long
Dim slR As Integer, slFirst As Integer, slLast As Integer
With ActiveSheet.UsedRange
rdFirst = .Rows(1).Row
rdLast = rdFirst + .Rows.Count - 1
slFirst = .Columns(1).Column
slLast = slFirst + .Columns.Count - 1
End With
PathCSV = ThisWorkbook.Path & "\"
NameCSV = "POKUS_1.csv"
SepCSV = Chr(34) & Chr(44) & Chr(34)
xFile = FreeFile
Open PathCSV & NameCSV For Output As xFile
For rdR = rdFirst To rdLast
MyStr = vbNullString
For slR = slFirst To slLast
MyStr = MyStr & SepCSV & Cells(rdR, slR)
Next slR
MyStr = Mid(MyStr, 3) & Chr(34)
Print #xFile, MyStr
Next rdR
Close xFile
End Sub
1)Vzorce nikam nic nezapíšou. Pokud mají platné argumenty vrátí požadovanou hodnotu. Nevím přesně co by to mělo dělat, ale tady předpokládám, že by bylo nutné makro.
2)Graficky lze vyjádřit téměř cokoliv, záleží jaká je představa.
Pro *.xlsm - FileFormat:=xlOpenXMLWorkbookMacroEnabled
Třeba:
R1C1
'=KDYŽ(INDEX(List1!R1C1:R100C2;POZVYHLEDAT(RC2;List1!R1C1:R100C1;0);2)>0;"O";"N")
A1
'=KDYŽ(INDEX(List1!$A$1:$B$100;POZVYHLEDAT($B2;List1!$A$1:$A$100;0);2)>0;"O";"N")
Není problém spíš tady?
http://wall.cz/index.php?m=topic&id=22744&page=1#post-22756
http://wall.cz/index.php?m=topic&id=22788
Třeba takto:Sub VZOR_MAIL()
Dim Cesta As String, JmenoSouboru As String
Dim Prijemce As String, Predmet As String, Odpoved As Boolean
Dim pzcx As Long
Cesta = ThisWorkbook.Path
JmenoSouboru = "POKUS_MAIL.xlsx"
Application.DisplayAlerts = False
With Workbooks.Add
For pzcx = .Sheets.Count To 2 Step -1
.Sheets(pzcx).Delete
Next pzcx
.Sheets(1).Name = "MAIL"
ThisWorkbook.Sheets(1).Cells.Copy .Sheets(1).Cells
.SaveAs Cesta & "\" & JmenoSouboru
DoEvents
Prijemce = "kabelpavel@seznam.cz"
Predmet = "Pokus Mail"
Odpoved = False
Workbooks(JmenoSouboru).SendMail Prijemce, Predmet, Odpoved
.Close False
End With
Kill Cesta & "\" & JmenoSouboru
Application.DisplayAlerts = True
End Sub
NeboSub VZOR()
Dim Cesta As String, Slozka As String, JmenoSouboru As String
Dim pzcx As Long
Cells(1, 2) = ThisWorkbook.Path
Cesta = Cells(1, 2)
Slozka = Cells(2, 2)
JmenoSouboru = Cells(3, 2)
If Not Slozka = vbNullString Then
Cesta = Cesta & "\" & Slozka
On Error Resume Next
If IsError(GetAttr(Cesta)) Then MkDir Cesta
On Error GoTo 0
Else
Slozka = "Blank"
End If
Application.DisplayAlerts = False
With Workbooks.Add
For pzcx = .Sheets.Count To 2 Step -1
.Sheets(pzcx).Delete
Next pzcx
.Sheets(1).Name = Slozka
ThisWorkbook.Sheets(1).Cells.Copy .Sheets(1).Cells
.SaveAs Cesta & "\" & JmenoSouboru
.Close False
End With
Application.DisplayAlerts = True
End Sub
Uživatelské menu
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články