XLSM musíte zabaliť do ZIP aby šiel nahrať.
V súbore XLSX nikdy žiadne makro byť nemôže. Na to je XLSM. Takže makro nevidíme. Toto je hlavný súbor, či ten dielčí ? Čo znamená "príhoda" ? To je akýkoľvek záznam v riadku spĺňajúcom v F:F nejaký dátum? Dielčie súbory sú v jednej samostatnej zložke ? Treba preskúmať všetky, ktoré v danej zložke sú ? Majú premenlivý názov listu asi, však ? Počet listov je rovnaký ? ...
Tak moment, čo Vy chcete vlastne vypísať?
-všetky ovládacie prvky formu bez MultiPages a bez Pages
-všetky ovládacie prvky formu aj s názvami MultiPages ale bez názvov Pages
-všetky ovládacie prvky formu aj s názvami MultiPages a Pages
-rozdeliť všetky ovládacie prvky formu tak ako patria do Multipages
-rozdeliť všetky ovládacie prvky formu tak ako patria do Multipages a príslušných Pages
-vypísať iba názvy všetkých MultiPages na forme
-vypísať iba názvy všetkých Pages na forme
-vypísať názvy všetkých MultiPages na forme a im zodpovedajúce Pages
Proste uveďte presne ako má vyzerať výsledok v tomto konkrétnom prípade.
Nemôžete testovať len Controls. Veď tá podstránka je Page, nie Control. Teda musíte prejsť všetky Pages v objekte ktorý má typ MultiPage, a v každom cykle kontrolovať Controls až v tej Page. Ale vidím, že sa jedná o niekoľkonásobné vnorenie MultiPage, teda bude potrebné urobiť rekurzívnu metódu. Zvládnete to ?
Pre prepočet viac ako jednej bunky:
Selection = Evaluate("=" & Selection.Address & "*1.852")
a pre prepočet viac ako jednej bunky, ale s ničnerobením keď je prázdna:
Selection = Evaluate("=IF(" & Selection.Address & "="""",""""," & Selection.Address & "*1.852)")
Samozrejme sa bavíme o súvislej oblasti (viacriadkovej alebo viacstĺpcovej alebo oboje), nie o oblasti "hocikde". Ak chcete tak, povedzte, tam sa musí urobiť cyklus pre všetky podoblasti Areas.
EDIT: Pre hocijakú oblasť nesúvislú, to je fuk, mení iba čísla, prázdne a nečíselné bunky nie:
Sub PrevodAreas()
Dim ARE As Range, Adr As String
For Each ARE In Selection
Adr = ARE.Address
ARE = Evaluate("=IF(ISNUMBER(" & Adr & ")," & Adr & "*1.852," & Adr & ")")
Next ARE
Set ARE = Nothing
End Sub
lopi007: on testuje či je Outlook otovrený obdobne:
...
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
...
Nomi: "...se to zasekne..." - Na ktorom riadku ?
Skôr si myslím, že je problém v tom čo sa tu spomínalo len pár týždňov dozadu (sa mi nechce hľadať tú tému), a to, že staršie Office pristupujú k obj. modelu Outlook inak.
Dim objOL as Object
Set objOL = CreateObject("Outlook.Application")
vs
Dim objOL as Outlook.Application
Set objOL = New Outlook.Application
Prípadne pridať referenciu na Microsoft Outlook xx.x Object Library.
Mne to na Office 2016 funguje, tak ako chcete. Akú máte verziu, možno tam bude problém.
Trochu sa nad tým pozastavujem, lebo neviem načo pridávať ďalší riadok každý deň. Veď keď prídem po max 31 tak musím pridať nový stĺpec každý mesiac. Teda určite nezačínam ďalší mesiac na 32-om dátovom riadku. Ja by som si vytvoril 31 riadkovú tabuľku, nešpekuloval s pridávaním riadkov a vypĺňaním vzorcov, ale vzorce by som ošetril napr. na nevypisovanie hodnoty, a pridával by som len mesiac - teda stĺpec. V prvom momente ma to netrklo, ale teraz v tom pridávaní riadkov nevidím logiku.
Range má režim R1C1, alebo namiesto neho použite Cells(riadok,stlpec), k tomu napr. .Offset() alebo .Resize(). Skúste sa na to mrknúť vlastnými silami, no ak to nedáte, tak niekto pomôže. Keď nebudem na mobile... Jáj a ešte, ktorý riadok sa dá spoĺahlivo použiť na určenie posledného stĺpca ? Riadok 8 ?
Tak ako to popisujete, tak to funguje, bez poškodenia nezobrazených riadkov. Rovnako ako aj napísanie jednej hodnoty a ťahanie za roh.
Tak skúste toto, je to na zmenu v stĺpci K. Vidím, že asi budete chcieť po odoslaní preniesť 0 riadky do druhého listu, to už zvládnete.
Určite ? Mne to fachá na všetky súbory, či už XLS, XLSX, XLSM, otvárané priamo, otvárané z archívu. Nič nepadá, robí to to čo má, kopíruje ten dátum.
-určite máte v XLSB aj tú triedu definovanú v ThisWorkbook ?
-v samotnej triede cExcelEvents si už iba zamente ten msgbox Hello za Váš kód. Ja som to urobil za Vás tu to máte.
-Uložil ste ten XLSB po úprave?
-pozatvárajte Excel
-zálohujte si Váš XLSB súbor bokom. Nahraďte ho týmto v adresári
c:\Users\Vaše_meno\AppData\Roaming\Microsoft\Excel\XLSTART\
Kto nechce sťahovať tak:
V XLSB - ThisWorkbook
Option Explicit
Private XLApp As cExcelEvents
Private Sub Workbook_Open()
Set XLApp = New cExcelEvents
End Sub
V XLSB - cExcelEvents
Option Explicit
Private WithEvents App As Application
Private Sub Class_Initialize()
Set App = Application
End Sub
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
'// Prevent message when this workbook is opened
If Wb.Name <> ThisWorkbook.Name Then
'MsgBox ("Hello")
Range("C2").Select
ActiveCell.FormulaR1C1 = "7/25/2017"
Range("C2").Select
Selection.NumberFormat = "yyyy/mm/dd"
Range("C2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
End If
End Sub
Malo by to ísť cez triedu:
EDIT: Ale s vykonaním zmiem pri otvorení "každého zošitu" by som bol veľmi opatrný, a poriadne ošetril ako má makro zistiť, či sa jedná o vhodný zošit. Vaše makro na vkladanie dátumov nenávratne zničí celé stĺpce C v akomkoľvek zošite. Uvedomujete si to dúfam.
Ak je príloha xlsm, musíte ju zabaliť do ZIP/RAR, a nesmie byť väčšia ako 256KB. Ak sa nezmestí, uploadnite ju niekde na Free úložisko a dajte odkaz.
Tak potom aj takto sa dá, a definovaným názvom ľahko nahradíte A1:A5 dynamickou oblasťou.
=(MAX(A1:A5)-MIN(A1:A5))/(COUNTA(A1:A5)-1)
=(MAX(A1:A5)-MIN(A1:A5))/(POČET(A1:A5)-1)
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
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.