Příspěvky uživatele

Což o to příklad dát můžu ...

Super, to je přesně ono. Naštěstí mastertag bude vždy jen jeden :-).

Děkuju
M@

Díky za příklad, to já si s tím oklikou dokážu poradit, jen mě zajímá, jestli lze použít excelovskou funkci FILTERXML na získání konkrétního tagu z poskytnutého XML, což je v podstatě obsah buněk A3 nebo C3, kdy je zde pokaždé trochu jiný formát.
U XML z A3 to funguje viz. vzorec v buňce A9.
Mě by ale zajímalo jestli by to šlo i z XML z buňky C3, vzorec v buňce B9 - tento se mi nedaří rozeběhnout, otázkou je jestli dělám chybu já někde v syntaxi dané funkce, nebo jestli to prostě z tohoto formátu XML tato funkce neumí.

To že to jde obejít spoustou jiných způsobů to mi je jasné, ale proč to dělat oklikami, když by to teoreticky mohlo jít pomocí vestavěných funkcí.

Díky
M@

Jen tak na zkoušku v příloze mám XML dle příkladu z nápovědy Excelu a pak druhé XML což je vlastní příklad generovaný skrze webservice.
Když použiji funkci FILTERXML, na vzorový XML, tak dostanu to co hledám, otázkou je, jestli to vůbec jde použít na ten můj XML - nějak se mi to nepodařilo (červeně podbarvená buňka) a tak jsem to musel obejít složením několika funkcí.
Prosím tedy o názor ostatních jestli to vůbec jde a pokud ano, tak bych za příklad nezlobil :-).

Díky
M@

Zdravím, zas bych se jednou zkusil zeptat, kde by mohl být problém ...
Na list vložím obrazec obdélník a nastavím mu výšku 9,2cm.
Spustím tisk, zvolím volbu bez měřítka (tzn. 100% dle zobrazení), vytisknu a ejhle výška obrazce na papíře je jen 8,9cm.
Dělám chybu já, nebo má excel někde chybu v přepočtech z cm? Pokud to druhé, tak nezbyde než používat koeficient abych se dostal tam kam chci.

Díky
M@

nebo místo c = ""
zkus
c.Value = ""

myslím, že u sloučených buněk nefunguje příkaz ClearContents
pak bych zkusil ...
If c.Locked = False Then c=""

M@

Jen takový rychlo pokus ...
For Each c In ActiveSheet.UsedRange
If c.Locked = False Then c.ClearContents
Next

M@

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim arr() As String
Dim i As Integer
Dim ns As Outlook.Namespace
Dim itm As MailItem
Dim m As Outlook.MailItem

On Error Resume Next
Set ns = Application.Session
arr = Split(EntryIDCollection, ",")
For i = 0 To UBound(arr)
Set itm = ns.GetItemFromID(arr(i))

If itm.Class = olMail Then
Set m = itm
If m Is Nothing Then Exit Sub

'Zde je možnost nastavit filtr na předmět zprávy, tzn. ukládat se budou pouze přílohy zpráv začínajících daným textem
If Left(m.Subject, Len("PREDMET ZPRAVY")) = "PREDMET ZPRAVY" Then
SaveAtt m
End If

End If
Next
Set ns = Nothing
Set itm = Nothing
Set m = Nothing
End Sub

Public Sub SaveAtt(ByRef itm As MailItem)
On Error Resume Next
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\PRILOHY\"

For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & objAtt.DisplayName
Next
itm.UnRead = False
End Sub

M@

Dobrý den,

Rád bych vytvořil doplněk, který ale chci aby byl sdílený na firemní síti, aby se případná změna promítla opět všem.
Rád bych aby doplněk byl "samoinstalační" a uživatelé nemuseli jít do doplňků a doplněk přidávat.

Doplněk mám připravený a v podstatě se spuštěním XLAM souboru, chci aby se uživateli nainstaloval, kód vypadá následovně ... Public TAddin As AddIn

Private Sub Workbook_Open()

If AddInExist = False Then
If Workbooks.Count = 0 Then Workbooks.Add
Set TAddin = AddIns.Add(ThisWorkbook.Path & "\" & ThisWorkbook.Name, False)
TAddin.Installed = False
TAddin.Installed = True
Else
If TAddin.Installed = False Then
If TAddin.IsOpen = False Then TAddin.Installed = True
End If
End If

Set TAddin = Nothing
End Sub

Public Function AddInExist() As Boolean
AddInExist = False
For Each myaddin In AddIns
If UCase(Left(myaddin.Name, Len("TESTAddIn"))) = "TESTADDIN" Then
AddInExist = True
Set TAddin = myaddin
Exit For
End If
Next
End Function

kdy po otevření dojde k ověření jestli doplněk již existuje (funkce AddInExist) a pokud ano, tak je nastaven do veřejné proměnné, pokud ne, tak je přidán a nastaven do stejné proměnné.

Problém nastane, když chci nastavit vlastnost "TAddin.Installed = True", tady mi to spadne. Myslím, že důvod je ten, že doplněk automaticky padá mezi zakázané doplňky a takovému asi nelze programově nastavit Installed = true.

Tak bych se rád zeptal, jestli už toto někdo neřešil?
Díky
M@

Sice ne ve VBA, ale zkoušel jsem toto a nějak to i fungovalo :-).
https://code.msdn.microsoft.com/External-Program-Text-Read-1707f800/sourcecode?fileId=145770&pathId=936135888
Buď pomůže, nebo to ignoruj :-)

M@

Zkuste nahradit tento řádek
wso.Cells(rd, 3) = wsi.Range("D5")
za
wso.Cells(rd, 3).Formula = "='" & wb.Path & "\[" & wso.Cells(rd, 1) & ".xlsx]" & wsi.Name & "'!$D$5"
M@

jen tak narychlo ...
Public Sub NACTIDATA()
Dim ex As New Application
Dim wb As Workbook
Dim wsi As Worksheet
Dim wso As Worksheet
Set wso = ActiveSheet

Application.ScreenUpdating = False

For rd = 2 To wso.UsedRange.Rows.Count
Set wb = ex.Workbooks.Open(ThisWorkbook.Path & "\" & wso.Cells(rd, 1) & ".xlsx", False, True)
Set wsi = wb.Sheets(1)
wso.Cells(rd, 3) = wsi.Range("D5")
wb.Close
Next

ex.Quit
Application.ScreenUpdating = True
End Sub

M@

Tak na bod 2 už bych odpověď měl :-) - lze to ... Velikost a Vlastnosti -> Zaškrtnou zakázat změny velikosti a přesouvání.
Nicméně to nikomu nezabrání to zrušit, ale snad nikdo tak moc šťourat nebude :-)

Tak nějak jsem se s tím před pár lety taky pral a nakonec to vzdal. Nakonec jsem šel cestou přidání makra do daného excelu, které vygeneruje vždy novou prezentaci a potřebné informace do ní vloží jako obrázek.
Záleží ovšem o typu tvé prezentace. Toereticky by excel mohl i otevřít stávají prezentaci a na konkrétní slide vložit konkrétní data z excelu formou obrázku.

M@

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje