Děkuji za navržený způsob, který mně inspiroval ke konečnému řešení. Ve finále nakonec stačilo použít Replace přímo do Inputboxu:
sgBanka = Application.InputBox(Prompt:="Zadej počet přesčasových hodin", Default:=Replace(sgPrescasy, ".", ","), Type:=1)
Ahoj, když mám tento příkaz:
sgBanka = Application.InputBox(Prompt:="Zadej počet přesčasových hodin", Default:=sgPrescasy, Type:=1)
a proměnná sgPrescasy není celé číslo (dejme tomu že má hodnoutu 4,5), tak se v inputBoxu zobrazí s tečkou místo čárky a když se zvolí OK, tak mi to do sgBanka načte nesmyslnou hodnotu 43956. Napadá mně to číslo rozbít na celou a desetinnou část a pak textově mezi to dát čárku. Ale jednak tuším, že si tím přidělám další potíže a myslím si, že na to musí být nějaký jednoduchý trik aby to inputbox chápal korektně...
Předem dík
Jenom můj poznatek ze zalamování řádků ve VBA za použití " _"
I toto má své omezení, někde kolem dvacátého zalomení to hlásilo, že dál už to nejde. Dělal jsem to kvůli přehlednosti Array, abych měl jednotlivé prvky pod sebou...
Nevím, jestli to bude fungovat, ale soudě podle následujícího kódu (ten vytvoří z excelu outlookovou zprávu), bych zkusil
OLAppointment.Body = "Zdarec!"
With OutMail
.To = "pacos1@moria.com" 'komu
.CC = "pacos2@moria.com" 'kopie
.Subject = "test odeslání e-mailu" 'předmět
.Body = "Dobrý den, " & vbCrLf & "..." & vbCrLf & "S pozdravem" 'text zprávy
.Attachments.Add "C:\Users\userXY\Documents\utahovací_momenty.pdf"
.Importance = 2 'vysoká důležitost
.Display 'zobrazí to tento e-mail s přílohou bez odeslání
' .Send 'anebo rovnou to odešle
End With
Přikládám.
chvilku mi trvalo než jsem to anonymizoval, neboť bych nerad vystavoval skutečná data.
Normálně platí ten první zaremovaný řádek, neboť cesta k DB bývá konstanta. Pro tuto verzi jsem to udělal jako proměnnou, tak aby umístěním DB byl stejný adresář
'Public Const DataSourcePath As String = "\\brsv002\Servis\Prehled_ND\Prehled_ND.mdb" 'cesta k DB na serveru
Public DataSourcePath As String 'toto je pro verzi, kdy DB je ve stejném adresáři jako tato konzole
Taky jsme měli léta podobný problém, bylo to ale ve sdíleném sešitě, který současně editovalo několik uživatelů. Soubor hrozně bobtnal a sem tam úplně vytuhl. Občas firma utrpěla ztrátu kvůli záhadně zmizelé informaci. Nový excel 365 dokonce toto sdílení "přestal nabízet" i když se to dalo dodatečně zobrazit.
Nakonec jsem vytvořil řešení a to tak, že data jsou uložena na serveru v databázi v mdb formátu a uživatelé mají excelovou "konzoli", která vypadá takřka stejně jako původní tabulka. Když uživatel změní nějaký řádek, tak ho odešle do DB. Každý uživatel si kdykoli může "občerstvit data" do hloubky historie jakou si nastaví.
Obrovská spokojenost i spolehlivost oproti původnímu řešení.
Pokud bys měl zájem, nemám problém řešení zveřejnit, můžeš si ho přizpůsobit svým požadavkům. Je tam několik formulářů a mraky kódu, ale vše odemčené
V příloze nástřel. Pokud je v buňce datum > 31.12.1999, tak se to podbarví, jinak ne
vyhodnocovací vzorec je tento:
=KDYŽ(JE.CHYBA(ROK($D2));NEPRAVDA;KDYŽ(ROK($D2)>1999;PRAVDA;NEPRAVDA))
Chyba s mezerou to nesouvisí.
* Nastav si stopku na příkazu MkDir.
* Mrkni, co máš v proměnné rFolder
* Pokud rFolder je o jeden podadresář hlouběji, než existující, tak ho vytvoří. Ale nevytvoří současně dva.
Takže ve stávající cestě vytvoří adresář \01 Materiál
ale nevytvoří dvě úrovně čili \01 Materiál\Tecam. To už vede k chybě kterou popisuješ.
Ta procedura má problém, s verzí excelu to nesouvisí
Tady máš ladicí procedurku (upravený extrakt ze stávajícího makra)
Sub TestMD()
Dim i As Integer, a As Integer
a = 2
i = 4
FolderPath = ThisWorkbook.Path
bFolder = Sheets("Definice poptávky").Cells(a, i).Value 'NázevDodavatele
aFolder = Sheets("Definice poptávky").Cells(a, 1).Value
rFolder = FolderPath & "\" & aFolder
sFolder = FolderPath & "\" & aFolder & "\" & bFolder 'CestaSložkyDodavatele
MkDir rFolder
If Len(Dir(sFolder, vbDirectory)) = 0 Then
ChDir FolderPath
MkDir aFolder 'Založení složky dodavatele
MkDir rFolder 'Založení složky dodavatele
End If
End Sub
UsedRange.Areas.Count je vždy = 1
Pokud vybereš nesouvisle oblast, tak to poznáš příkazem selection.areas.count, tam to bude > 1
Dotaz zněl na UsedRange, ale není známo, čeho chceš dosáhnout. Možná, že se dá použít jiných vlastností či metod objektu Range ...
Jasně, můžete mít chybu v oné buňce.
Jinak MkDir funguje i v Office365, klidně si to zkuste:
Sub TestMkDir()
Dim strPath As String, aFolder As String
strPath = ThisWorkbook.Path
aFolder = "TestFolder"
If Dir(strPath & "\" & aFolder, vbDirectory) = "" Then 'pokud adresář neexistuje, tak ho vytvoř
MkDir strPath & "\" & aFolder
End If
End Sub
Je několik možností pro definici oblasti:
všechny souřadnice jsou proměnné:
Range(Cells(prvni_Radek, prvni_Sloupec),Cells(posledni_Radek, posledni_Sloupec))
začátek oblasti a počet sloupců jsou konstantní:
Range("A2:F" & posledni_Radek)
hranaté závorky to dovedou zjednodušovat, ale sem-tam je s tím obtíž, tak je používám zřídka:
Range("A1") se dá zapsat jako [A1]
Range("Zakaznici") se dá zapsat jako [Zakaznici]
Obávám se, že z excelu to nezjistíš, neboť pokud je buňka v edit módu, tak asi nic nespustíš.
Dalo by se to asi otestovat nepřímo z jiné aplikace, zde příklad z Wordu:
https://stackoverflow.com/questions/47902259/find-out-if-excel-is-in-edit-mode-from-word-vba
Asi by to chtělo blíže specifikovat. Pokud chceš vědět, jestli je soubor otevřený, tak projdeš všechny otevřené: For i = 1 To Workbooks.Count
a budeš se uvnitř For dotazovat na jméno If Workbooks(i).Name= "xyz.xlsx" Then
Dita napsal/a:
Děkuji, i když tomu nějak nerozumím
Ahoj,
abych se vyhnul potížím s chybějícími referencemi, tak používám přiložený kalendář, který má celou logiku v sobě.
Úspěšně mi to už několik let běží ve dvou aplikacích (desítky uživatelů). Sice máme office 32bit, ale jede to i na 64bitech. Tam to sice nemám otestováno v dlouhodobém ostrém provozu, ale při testování na Office 64b to fungovalo.
Takže vyzkoušej
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.