Příspěvky uživatele
< návrat zpět
Když se zaregistrujete a vložíte sbalený soubor, tak se můžeme bavit konkrítně.
Makro nevkládejte do modulu, ale přímo do listu - viz. přiložený obrázek
Soubor není přiložen.
Soubor s makrem se musí sbalit
Musí být samozřejmě zamknutý list.
Buňky do kterých se má zapisovat musí mít vypnutý zámek.
Nedělal bych rozsah A:A, ale podle skutečného rozsahu (v příkladu je A1:A20)
List se v makru musí pojmenovat podel skutečnosti, případně doplnit i "Workbook" pokud se makro nebude spouštět přímo z procedury v listu.
Sub klouzavyZamek1()
Dim cell As Range
'odemknout list
Sheets("List1").Unprotect
'nastavit zámek v buňce ve sloupci B, která odpovídá podmínce
For Each cell In Range("A1:A20")
If cell.Value >= Date And cell.Value < Date + 14 Then
Cells(cell.Row, 2).Locked = True
End If
Next
'zamknout list
Sheets("List1").Protect
End Sub
=ČAS(CELÁ.ČÁST(A1/100);ZPRAVA(A1;2);0)-ČAS(CELÁ.ČÁST(B1/100);ZPRAVA(B1;2);0)
Ještě bych upravil toto: If UserForm1.Controls("TextBox" & druhySloupec).Value > "" Then na toto: If UserForm1.Controls("TextBox" & druhySloupec).Value <> "" Then
Pravý sloupec, čtvrtý TextBox od spodu je TextBox140. Další (třetí odspodu) je TextBox142. Chybí TextBox141.
Takže přejmenovat poslední 3 TextBoxy v pravém sloupci.
Tím pádem se změní cyklus. Místo For druhySloupec = 125 To 144 bude For druhySloupec = 125 to 143
Prostě spodní index a horní index (kdybyste přidával textboxy, tak je na to třeba pamatovat
pak je třeba opravit tento příkaz (v původnm špatném kodu chybí písmenko L) Správně je: prvniSloupec = prvniSloupec + 1
Takže správně je:
For druhySloupec = 125 To 143
.
.
.
prvniSloupec = prvniSloupec + 1
end if
Next
djflyash napsal/a:
Opakuje to stejný záznam z TextBox1 do prvního sloupce
djflyash napsal/a:
a dává to chybu "Could not find specified object"
Vložte novou přílohu.
Pojmenoval bych si sloupce vzestupnou číselnou řadou např.:
TextBoxy v prvním sloupci TextBox1 - TextBox19
TextBoxy v druhém sloupci TextBox125 - TextBox144
nebo 1 - 19 a 101 - 119 - je to jedno
pak by to mohlo být třeba takto:Dim prvniSloupec As Integer, druhySloupec As Integer
prvniSloupec = 1
For druhySloupec = 125 To 144
If UserForm1.Controls("TextBox" & druhySloupec).Value > "" Then
'Trh - stejny
Cells(posledni + 1, 1).Value = "CZ"
'Název - stejny
Cells(posledni + 1, 2).Value = UserForm1.Label10.Caption
'Konkurent
Cells(posledni + 1, 3).Value = UserForm1.Controls("TextBox" & prvniSloupec).Value 'původně TextBox117.Value
'Odkaz
Cells(posledni + 1, 4).Value = UserForm1.Controls("TextBox" & druhySloupec).Value 'původně TextBox125.Value
'Kod - stejny
Cells(posledni + 1, 5).Value = UserForm1.Label9.Caption
'PM_S - stejny
Cells(posledni + 1, 6).Value = UserForm1.TextBox1.Value
posledni = posledni + 1
prvniSloupec = prvniSoupec + 1
End If
Next
Nebo takto:Range("A2").FormulaLocal = "=KDYŽ(NEBO(D2="""";JE.PRÁZDNÉ(E2));"""";D2*E2)"
Jestli jste to zkoušel, tak jste ten pokus mohl vložit. Ne proto, abychom se smáli, ale můžeme ukázat kde jste udělal chybu.
=KDYŽ (List2!A1 = 5;1;0)
Nemyslíte spíš tabulku formátovanou jako Tabulku?
Kontingenční tabulka je vlastně jen výstup nějaké zdrojové tabulky. Nebo nechápu váš dotaz.
Tady je varianta, kdyby bylo těch jmen víc pod sebou:=VVYHLEDAT(A$4;List1!$A$2:$DG3;ŘÁDEK()-3;NEPRAVDA)
Vyřešeno.
Znovu potvrzení, jak je příloha důležitá.
Nechal jsem si poslat soubor od @lukhas a problém není v makru, ale ve vzorečcích.
Vzorce v jednotlivých listech odkazují na primární list. A v odkazování na primární list je chyba, proto makro "nefunguje"
Trošku jsem to od @Milan-158 doplnil.
Sloupec vyhledá podle hlavičky. Pozor! Sloupec "Telefónne číslo" mělo vprostřed odřádkování a na konci mezeru. Je potřeba opravit buď hlavičku v tabulce a nebo název v makru. Musí to být stejné, jinak to nenajde.
Public Sub EXPORT_Harku_do_textu()
Application.EnableEvents = False
' tento zapis zaisti to, ze bude znemoznene volanie procedur spustenych na zaklade udalosti. Na konci kodu je nutne udalosti znovu 'zapnut'
Dim cesta As String
Dim nove_meno As String
Dim cele_meno As String
Dim zdroj As String
zdroj = ActiveWorkbook.Name ' nastavenie mena zdroju - meno povodneho zositu
cesta = ActiveWorkbook.Path ' nastavenie cesty pre ulozenie dat - tam kde bol povodny zosit otvoreny
Application.DisplayAlerts = False
ActiveSheet.Copy ' skopiruje cely aktivny harok do noveho zositu
ActiveSheet.Cells.UnMerge ' zrusi zlucenie buniek
'********************************** vložený kód ****************************
Dim i As Long, iMxRow As Long
Dim sloupecDatum As Long, sloupecTelefon As Long
Dim NajdiDatum As Range
Dim NajdiTelefon As Range
'******* najde sloupec s datem
Set NajdiDatum = Range("4:4").Find("Dátum narodenia")
If NajdiDatum Is Nothing Then
MsgBox ("Sloupec s datem nenalezen")
Else
sloupecDatum = NajdiDatum.Column
End If
'******** najde sloupec s telefonem
Set NajdiTelefon = Range("4:4").Find("Telefónne číslo")
If NajdiTelefon Is Nothing Then
MsgBox ("Sloupec s telefon nenalezen")
Else
sloupecTelefon = NajdiTelefon.Column
End If
iMxRow = Range("E65000").End(xlUp).Row
If iMxRow > 4 Then
For i = 5 To iMxRow
Cells(i, sloupecDatum) = Format(Cells(i, sloupecDatum).Text, "'dd.mmm.yyyy'")
Cells(i, sloupecTelefon) = Format(Cells(i, sloupecTelefon).Text, "0000\ 000\ 000")
Next i
End If
'*************************************** End *************************************
'Workbooks(zdroj).ActiveSheet.Cells.Copy ' skopiruje povodny harok
'ActiveSheet.Cells(1, 1).Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' iba hodnoty skopiruje do noveho harku (aby nekopirovalo pripadne vzorce vsetko potrebujem mat v texte)
'Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheet.Cells.NumberFormat = "@" ' nastavi format celeho noveho harku do textu, pretoze cely harok musi byt vo formate textu
nove_meno = "Zosit " ' predpis noveho mena
Dim filename As Variant ' nastavenie cesty pre ulozenie
filename = Application.GetSaveAsFilename(nove_meno, "Excel (*.xlsx),*.*,Excel 98-03 (*.xls),*.*,", 1, "Uložiť ako") ' zobrazi sa okno 'ukladania'
If filename = False Then Exit Sub
cele_meno = filename
ActiveWorkbook.SaveAs (cele_meno) ' ulozenie zositu do standartnej cesty ukladania
ActiveSheet.Cells(1, 1).Select ' odklikni oznacenie celeho harku
Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.EnableEvents = True ' volanie procedur spustenych na zaklade udalosti 'zapnut'
End Sub
Já jsem to pochopil tak, že si to nakopíruje do Excelu a v Excelu to pak chce dále zpracovávat.
Ale to nic nemění na tom, že by to chtělo přílohu. Stačí pár řádků, také data prodat na jiné ve stejné struktuře...
Uživatelské menu
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
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.
RSS nejnovější články