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

Příspěvky uživatele

@pvav
"Respektíve, nainštaloval by mu addin pre konkrétny zošit (napr. pre zošit Report1.xlsx addin Addin1.xlam, ...)"
Toto by pravděpodobně šlo.
Jenže mi to přijde zbytečně komplikované - pokud se nejedná a tisíce procedur, tak mi přijde jednodušší dát je do jednoho doplňku (pro všechny soubory) a volat ten jeden doplněk.

Pokud chcete testovat, který soubor (bez kódu, takže v něm nelze použít událost) je otevřen a podle něj něco dělat (otevírat doplněk), tak asi stejně budete muset mít nějaký doplněk, který toto zajistí, nainstalován.

k tomu eventu - v rychlosti například:
1 standardní modul s kódem (využiji Auto_Open)Public test As Class1

Sub Auto_Open()
Set test = New Class1
Set test.App = Application
End Sub1 modul třídy s kódemPublic WithEvents App As Application

Private Sub App_NewWorkbook(ByVal Wb As Workbook)
MsgBox Wb.Name
End Sub

Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
MsgBox Wb.Name
End SubPři otevření nového souboru dojde k vypsání názvu otevřeného souboru.
Nicméně, excel má tendenci zapomínat, takže bych se přikláněl k 1 doplňku, v něm všechny potřebné procedury ke všem typům souborů (např. v modulech) a v těch souborech je volat.
Do excelu 2003 se dalo využít reference - pokud jste v referenci zadal soubor, který obsahoval kód, ten se otvřel s tímto souborem. Měl jsem v plánu to více prozkoumat, ale protože mi to od 2007 přestalo fungovat, tak jsem to už nezkoumal.

@pvav
díky za info
toto není dobré řešení, protože tím znemožníte prvotní instalaci (tzn. pokud doplněk ještě není v seznamu doplňků, zastaví se kód hned na dalším řádku.

Taxe mi to konečně podařilo nasimulovat ;)
Jde o známou chybu, řešení je např. zde
http://www.oraxcel.com/cgi-bin/yabb2/YaBB.pl?num=1259052558

Takže před řádky With Application.AddIns
.Add sInstalPath & THIS_ADDIN_FULLNAME, CopyFile:=False
.Item(THIS_ADDIN_NAME).Installed = True
End With 'Application.AddIns vložte kód z odkazu a mělo by to fungovat

úprava: If Application.ActiveWorkbook Is Nothing Then
Application.Workbooks.Add
End If
With Application.AddIns
.Add sInstalPath & THIS_ADDIN_FULLNAME, CopyFile:=False
.Item(THIS_ADDIN_NAME).Installed = True
End With 'Application.AddIns

Takovéhle šílenosti se mi ani nechce vymýšlet. Navíc není třeba.
Google a hele
http://msdn.microsoft.com/en-us/library/office/ff193220(v=office.15).aspx

Nicméně toto je excel a takovýchle záležitosí bych se raději vyvaroval.

Toto bych hlavně vůbec neřešil v excelu, ale v textovém editoru. Tomu je jedno, kolik to má řádků či sloupců.

Ale souhlasím s Dingem

Vytvořte si jeden graf ručně a ten potom kódem kopírujte a měňte pouze zdrojová data.
Tedy pokud se jedná o tentýž graf ve stovce! souborů

...pokud by se sjednotil formát, bylo by pak možné do sloupce F přidat mezery do nejdelšího čísla?
Moc tomu dotazu nerozumím.

Dal jsem do procedury konstantu THOUSEP_COLS, do které oddělené čárkou napíšete písmena sloupců, kde chcete použít oddělovač tisíců.
U mně to funguje:Sub subExport()
Const THOUSEP_COLS As String = "F" 'e.g. "A,C,D"

Dim sThouSepCols As String
sThouSepCols = Replace(THOUSEP_COLS, " ", vbNullString)
sThouSepCols = Replace("," & THOUSEP_COLS & ",", ",", ":,$")

Dim rCol As Range, sFormat As String
For Each rCol In ActiveSheet.UsedRange.Columns
With rCol
If Not Application.WorksheetFunction.CountIf(.Cells, "<>") = 0 Then
sFormat = Application.WorksheetFunction.Rept("?", Evaluate("MAX(LEN(" & .Address & "))"))
If Not InStr(sThouSepCols, Left(.EntireColumn.Address, InStr(.EntireColumn.Address, ":"))) = 0 Then
sFormat = Trim(Left(sFormat, Len(sFormat) Mod 3) & Replace(Right(sFormat, 3 * (Len(sFormat) \ 3)), "???", " ???"))
End If
.NumberFormat = sFormat
.Value = .Value
End If
End With 'rCol
Next rCol
Set rCol = Nothing

ActiveWorkbook.SaveAs Filename:="V:\Export.txt", FileFormat:=xlText, CreateBackup:=False
End Sub

Auto_Open bylo nahrazeno Workbook_Open, ale je možné, že v sešitu můžou být obě možnosti. Někdy zkusím.
Ano, to by mohlo být využití, že bude vše pěkně pohromadě v jednom modulu.

Já ale Workbook_Open volám z jiného sešitu a modul modUpdate je nastavený jako private (aby nebyla makra viditelná ze sešitu), kdo ví jestli by to fungovalo.

Věřte, že jsem to zkoušel různé možnosti, než jsem to sem dal a vážně mi to vždycky projede ;) (přes sebe, pod sebe, nad sebe, bez sebe).
Nevím kde Vám to vázne, třeba to zkusí ještě někdo ;)

Auto_Open jsem použil naposledy snad v E97, teď už bych ho tam dal jen kvůli kompatibilitě (1x za 10 let). Možná mně přesvědčíte, v čem je lepší.

Kill - přepisuji IDoNothing.xlam, tak by tam snad měl být - ale možná to funguje i bez toho. Ničemu to neškodí ;)

Mno ono je to trochu problém. Ty čísla jsou samozřejmě zarovnaná doleva, to už vychází z podstaty txt souboru. Abyste je měl zarovnané vpravo, musíte před kratší čísla vložit tolik mezer, kolik chybí do nejdelšího čísla v daném sloupci (jestli rozumíte - kromě sloupce F jsou všechny hodnoty ve sloupci stejně dlouhé, proto jsou "zarovnané"). To by šlo, jenže problém je, že v některých buňkách máte formát text a v něm textové řetězce, v jiných buňkách zase číslo s formátem # ##0.

Pokud netrváte na oddělení tisíců, tak mi fungujeSub subExport()
Dim rCol As Range
For Each rCol In ActiveSheet.UsedRange.Columns
If Not Application.WorksheetFunction.CountIf(rCol, "<>") = 0 Then
rCol.NumberFormat = Application.WorksheetFunction.Rept("?", Evaluate("MAX(LEN(" & rCol.Address & "))"))
rCol.Value = rCol.Value
End If
Next rCol
Set rCol = Nothing

ActiveWorkbook.SaveAs Filename:="V:\Export.txt", FileFormat:=xlText, CreateBackup:=False
End Sub

Trochu jsem si s tím hrál, ale nic moc to není.
Vlastní fceFunction fncGetHyperlinkURL(rCell As Range) As String
On Error Resume Next
fncGetHyperlinkURL = "[" & ThisWorkbook.Name & "]" & rCell.Hyperlinks(1).SubAddress
On Error GoTo 0
End Function
Fce na listu=HYPERTEXTOVÝ.ODKAZ(fncGetHyperlinkURL(INDEX(List2!$B$2:$B$65536;POZVYHLEDAT(A2;List2!$A$2:$A$65536;0)));INDEX(List2!$B$2:$B$65536;POZVYHLEDAT(A2;List2!$A$2:$A$65536;0)))

Běhá to, ale já htodkazy v listu nepoužívám, takže s tím extra zkušenosti nemám. Pravděpodobně vymyslí někdo něco lepšího ;)

Tak to neporadím, protože mně to nedělá ;)
Jen dávám odpověď ;)

Zkusil jste krokovat?
Asi ne, když jen dáváte report ;))

Nejste negramot - jenom pořádně nečtete ;)
Je to ale taky trochu moje chyba - já považuji nulování a vymazání za skoro to samé. Takže v mém prvním příspěvku bylo napsáno
nebo pokud tam chcete ty 0...

Private Sub Workbook_Open()
Range("B2, B3, C8, D8, E8, F8, C14, D14, E14, F14, G14, H14, I14, J14, K14, L14, M14, N14").value=0
End Sub

OK ;))

Range("B2, B3, C8, D8, E8, F8, C14, D14, E14, F14, G14, H14, I14, J14, K14, L14, M14, N14").ClearContents
Pojmenovaná oblast slouží nejen pro VBA, takže si něco najděte a prostudujte. Doporučuji ;)

Označte si všechny buňky určené k nulování.
Pojmenujte si oblast - např. K_NulovaniPrivate Sub Workbook_Open()
Thisworkbook.Names("K_Nulovani").Referstorange.Clearcontents
End Subnebo pokud tam chcete ty 0Private Sub Workbook_Open()
Thisworkbook.Names("K_Nulovani").Referstorange.value=0
End SubBudete to mít 1 krokem, tedy 1x přepočítáno

Můžete vložit přílohu?

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse