Příspěvky uživatele
< návrat zpět
Zdravím, potřeboval bych pomoci s přepočtem cen ve formuláři. Jde o snížení nebo naopak o zvýšení cen u položek v jednom sloupci. Připravil jsem userform kde se zadá v % hodnota a o tuto hodnotu by se měli přepočítat ceny ve sloupci. Více asi pochopíte v přiloženém souboru. Děkuji za případnou pomoc.
Zdravím, potřeboval bych konzultaci.
Mám ceník v excelu kde je několik maker. Tento sešit je plně funkční na 5 počítačích s různými OS a office 2003 - 2010. Nyní mě pár zákazníků kontaktovalo s tím, že sešit hlásí :"Compile error in hidden module : List6" a další problémy s makry "Makro´Ceník 2012.xls´! Otevři Menu nelze spustit. Toto makro není pravděpodobně v sešitu k dispozici nebo jsou zakázána všechna makra".
Zákazníci mají povolená makra a stále se tyto problémy s VBA zobrazují.
Nemáte někdo s tímto zkušenost popřípadě nějakou radu jak to odstranit a co to způsobuje?
Díky Martin
Děkuji moc. Moc jsi mě pomohl. Teď už to mám komplet:-)
Ještě jedna technická- Pokud mám v buňce napsaný vzorec (a v buňce není zobrazeno žádné číslo ani text) tak makro bere buňku jako obsazenou. Co s tím?
Děkuji, ještě prosím o radu jak nastavit sloupec z kterého se bude počítat obsazenost buňek. Už jsem z toho dneska nějak jelen, zkoušel jsem to nastavit na 2 sloupec ale marně:-)
Ještě dotaz, jak nastavit aby začátek kontroly obsazenosti buňek začínal od 10 řádku?
:-) To já jen aby diskuze nestála:-).
Mám rozpracovaný jeden sešit pro export reportů pro vedení firmy a snažím si to co nejvíce usnadnit.
Jinak děkuji, to je přesně to co jsem potřeboval:-)
Zase bych potřeboval pomoci s kódem.
Lze sestavit kód, který bude umět následující:
Tabulka o 100 řádcích. Potřeboval bych, aby makro zjistilo poslední obsazenou buňku ve sloupci A (od 1 do 100 řádku)a ostatní řádky za touto obsazenou buňkou hromadně skrylo až do řádku 100. Zkoušel jsem to postupným skrýváním buňěk, ale trvá to strašně dlouho (ve zkutečnosti mám řádků okolo 1 tisíce). Díky za případnou pomoc
Díky za pomoc. FUnguje přesně:-)
Díky, ještě maličkost. Podmínka, která má zjistit zda v daném adresáři již tento soubor existuje se spouští až po té, co je vytvořena kopie sešitu, takže hlásí, že už soubor s tímto jménem existuje (hlásí právě nově vytvořenou kopii). Šlo by to nějak udělat aby se nejprve zjistilo, zda soubor v adresáři existuje a pak aby se vytvořila kopie? Nevím zda jsem to vysvětlit správně.
Zde je testovací sešit. Kód je pod tlačítkem "vytvoř kopii".
Snažil jsem se dát dohromady níže uvedený kód, ale je tam nějaká chyba. Můžete se mě na to prosím někdo juknout kde je chyba/chyby?
Kód by měl Vytvořit kopie stránek do samostatného sešitu, a ten pojmenovat dle Buňky a zobrazit možnost uložit jako. Před uložením ještě podmínka zkontroluje zda již sešit s tímto číslem existuje.
Už jsem bezradný. Prosím o pomoc.
Sub Export_listu()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
zdroj = ActiveWorkbook.Name
ChDir Application.ThisWorkbook.Path
novy_subor = Worksheets("Nabídka").Cells(13, 18).Value '
Listy = Array("Faktura", "Nabídka")
Workbooks.Add
ActiveWorkbook.SaveAs filename:= _
novy_subor, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
For llist = 0 To UBound(Listy)
Windows(zdroj).Activate
Sheets(Listy(llist)).Select
Sheets(Listy(llist)).Copy before:=Workbooks(novy_subor).Sheets(1)
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("List1").Delete
Worksheets("List2").Delete
Worksheets("List3").Delete
Worksheets("Nabídka").Activate
Range("A1").Select
' následuje přejmenování
nove_jmeno = "" & novy_subor ' buňka I1 - číslo faktury
' nastavení cesty pro uložení
Dim filename As Variant
filename = Application.GetSaveAsFilename(nove_jmeno, "Excel (*.xls),*.*,Excel 07 (*.xls),*.*,", 1, "Uložit jako")
If filename = False Then Exit Sub
cele_jmeno = filename
'=existuje uz soubor faktury?
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(cele_jmeno) Then
sZprava = MsgBox("Ve vámi zvoleném adresáři již tento soubor existuje, chcete tento soubor přepsat?" & vbCrLf & "...zápis v databazi bude nezměněn...", vbYesNo, "Přepsat soubor?")
Select Case sZprava
Case vbNo
Workbooks(Workbooks.Count).Close (False)
Application.CutCopyMode = False
Exit Sub
Case vbYes
End Select
End If
Next llist
Application.DisplayAlerts = True
Application.ScreenUpdating = True
ActiveWorkbook.Close
End Sub
Diky, funguje.
Snažil jsem se dát dohromady níže uvedený kód, ale je tam nějaká chyba. Můžete se mě na to prosím někdo juknout kde je chyba/chyby?
Kód by měl Vytvořit kopie stránek do samostatného sešitu, a ten pojmenovat dle Buňky a zobrazit možnost uložit jako. Před uložením ještě podmínka zkontroluje zda již sešit s tímto číslem existuje.
Už jsem bezradný. Prosím o pomoc.
Sub Export_listu()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
zdroj = ActiveWorkbook.Name
ChDir Application.ThisWorkbook.Path
novy_subor = Worksheets("Nabídka").Cells(13, 18).Value '
Listy = Array("Faktura", "Nabídka")
Workbooks.Add
ActiveWorkbook.SaveAs filename:= _
novy_subor, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
For llist = 0 To UBound(Listy)
Windows(zdroj).Activate
Sheets(Listy(llist)).Select
Sheets(Listy(llist)).Copy before:=Workbooks(novy_subor).Sheets(1)
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("List1").Delete
Worksheets("List2").Delete
Worksheets("List3").Delete
Worksheets("Nabídka").Activate
Range("A1").Select
' následuje přejmenování
nove_jmeno = "" & novy_subor ' buňka I1 - číslo faktury
' nastavení cesty pro uložení
Dim filename As Variant
filename = Application.GetSaveAsFilename(nove_jmeno, "Excel (*.xls),*.*,Excel 07 (*.xls),*.*,", 1, "Uložit jako")
If filename = False Then Exit Sub
cele_jmeno = filename
'=existuje uz soubor faktury?
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(cele_jmeno) Then
sZprava = MsgBox("Ve vámi zvoleném adresáři již tento soubor existuje, chcete tento soubor přepsat?" & vbCrLf & "...zápis v databazi bude nezměněn...", vbYesNo, "Přepsat soubor?")
Select Case sZprava
Case vbNo
Workbooks(Workbooks.Count).Close (False)
Application.CutCopyMode = False
Exit Sub
Case vbYes
End Select
End If
Next llist
Application.DisplayAlerts = True
Application.ScreenUpdating = True
ActiveWorkbook.Close
End Sub
SUper, funguje perfektně.
Ještě se jen zeptám, bylo by těžké pojmenovat sešit dle Buňky A1 z listu Faktura?
Jinak děkuji moc. Pomohl jsi mě.
Našel jsem jedno použitelné makro pro export více listů, ale pro mou potřebu bych potřeboval pomoci s úpravou(viz příloha):
Aby se kopie listů uložila bez maker, dále místo vzorců zůstala jen hodnota v buňce. Prostě aby neexistovalo žádné propojení do zdrojového sešitu. Je to reálné?
Šla by do kódu přidat možnost, aby když se zkopírují listy tak aby se zobrazila možnost uložit jako, nebo aby se nový sešit automaticky uložil pod jménem Faktura + číslo v buňce A1?
Zkoušel jsem nějaké své pokusy, ale marně:-(
Díky moc za pomoc.
Uživatelské menu
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
RSS nejnovější články