v příloze je soubor xlsx, takže bez makercitovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: podmienka vo VBA
Uzamčeno - nelze přidávat nové příspěvky.
MS Excel
Téma: podmienka vo VBA 
Zaslal/a neck 28.8.2013 11:13
Dobry den
mam este jeden problem v makre na vytvaranie harkov podla aktualneho tyzdna.
Do vstupnej tabulky makro predvyplna cislo aktualneho tyzdna a nasledne po spusteni vytvori harok stym cislom. problem nastane ak makro spustim este raz s rovnakym cislom tyzdna ktory uz bol vytvoreny. Neviem napisat podmienku aby sa zobrazilo hlasenie ze uvedeny tyzden bol uz vytvoreny.
Private Sub Koeficient_Change()
If IsNumeric(Koeficient.Text) Then
koef = CSng(Koeficient.Text)
If koef <= 0 Then
MsgBox "Týždeň nemože byť nulový alebo záporný !!!", vbOKOnly + vbExclamation, "P O Z O R"
End If
If koef > 53 Then
MsgBox " Týžden nemože byť väčší ako 53 !!", vbOKOnly + vbCritical, "P r e h n a l s i t o !"
End If
Else
MsgBox "Zadaj číslo týždňa, nie text !", vbOKOnly + vbInformation, "Pozor na TEXT !"
End If
End Sub
v prilohe je uvedene makro.
Dakujem
neck
Příloha: 
14902_priklad.zip (7kB, staženo 27x)
14902_priklad.zip (7kB, staženo 27x) Uzamčeno - nelze přidávat nové příspěvky.moja chyba prilozil som zlu prilohu
Příloha: 14908_tabulka.zip (85kB, staženo 25x)
citovat14908_tabulka.zip (85kB, staženo 25x)Řešil jsem to bez přílohy takto.
Příloha: 14910_list_cislotydne.zip (14kB, staženo 25x)
citovat14910_list_cislotydne.zip (14kB, staženo 25x)Je to super ale ja som to potreboval doplnit do vyssie uvedeneho makra.
Ale aj tak dakujemcitovat
Ale aj tak dakujemcitovat
Mno jak bych to
když nechám bez komentáře tu diakritiku v názvu ovládacího prvku (čímž jsem nenechal ;) )
tak upravte následující makro
(asi to nebude úplně správně, protože z toho makra jsem 100% nevyčetl, jak má fungovat, ale nechte se inspirovat)
Sub Hd_spusť_Click()
Dim shNewSheet As Worksheet
On Error Resume Next
Set shNewSheet = ThisWorkbook.Sheets(Koeficient.Text)
On Error GoTo 0
If shNewSheet Is Nothing Then
Sheets("1_polrok").Copy After:=Sheets(2)
Set shNewSheet = ActiveSheet
With shNewSheet
.Name = Koeficient.Text
.Range(Sheets("Sablona").UsedRange.Address).Formula = Sheets("Sablona").UsedRange.Formula
.Range("F3:F76,I3:I76,L3:L76,N3:N76,Q3:Q76,S3:S76,V3:V76,X3:X76,AA3:AA76,AC3:AC76").Replace What:="1_polrok", Replacement:=Koeficient.Text
With .Columns("C:C")
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
End With '.Columns("C:C")
.Range("D3").Select
ActiveWindow.FreezePanes = True
ActiveWindow.Zoom = 70
Beep
If MsgBox(Koeficient.Text & " týždeň" & " bol vytvorený." & vbCrLf & " Chceš vytvoriť další ? ", vbYesNo + 256 + vbInformation, "Hlásim, že ") = vbNo Then
Unload Me
End If
End With 'shNewSheet
Else
MsgBox "List už existuje"
End If
Set shNewSheet = Nothing
End Subcitovat
když nechám bez komentáře tu diakritiku v názvu ovládacího prvku (čímž jsem nenechal ;) )
tak upravte následující makro
(asi to nebude úplně správně, protože z toho makra jsem 100% nevyčetl, jak má fungovat, ale nechte se inspirovat)
Sub Hd_spusť_Click()
Dim shNewSheet As Worksheet
On Error Resume Next
Set shNewSheet = ThisWorkbook.Sheets(Koeficient.Text)
On Error GoTo 0
If shNewSheet Is Nothing Then
Sheets("1_polrok").Copy After:=Sheets(2)
Set shNewSheet = ActiveSheet
With shNewSheet
.Name = Koeficient.Text
.Range(Sheets("Sablona").UsedRange.Address).Formula = Sheets("Sablona").UsedRange.Formula
.Range("F3:F76,I3:I76,L3:L76,N3:N76,Q3:Q76,S3:S76,V3:V76,X3:X76,AA3:AA76,AC3:AC76").Replace What:="1_polrok", Replacement:=Koeficient.Text
With .Columns("C:C")
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
End With '.Columns("C:C")
.Range("D3").Select
ActiveWindow.FreezePanes = True
ActiveWindow.Zoom = 70
Beep
If MsgBox(Koeficient.Text & " týždeň" & " bol vytvorený." & vbCrLf & " Chceš vytvoriť další ? ", vbYesNo + 256 + vbInformation, "Hlásim, že ") = vbNo Then
Unload Me
End If
End With 'shNewSheet
Else
MsgBox "List už existuje"
End If
Set shNewSheet = Nothing
End Subcitovat
Za diakritiku sa ospravedlnujem. Neislo tak o nu ako o podmienku ktora by vyriesila padnutie makra pri vytvarani nazvu harku ktory uz bol vytvoreny.
Podmieka funguje aj ked som spravnost makra trocha skryl. (nechcel som ist do porobnosti)
Dakujem za vyriesenie problemu (mono pomoze aj inym)
S pozdravom
neckcitovat
Podmieka funguje aj ked som spravnost makra trocha skryl. (nechcel som ist do porobnosti)
Dakujem za vyriesenie problemu (mono pomoze aj inym)
S pozdravom
neckcitovat
Uživatelské menu
Nejste přihlášen(a)
\n
\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