< návrat zpět

MS Excel

Téma: Přidání listu s aktuální datem rss

Zaslal/a Fantasyk 6.8.2020 19:32

FantasykAhojte,
mám takoví problém přidám list přejmenuji ho podle aktuálního data, ale nastane problém, když někdo v jeden den klikne 2x ( napíše to chybu, jelikož se název listu už v sešitu nachází 7 )

Sub add()

Sheets("VZOR").Visible = True
Dim copr As String
copr = ActiveSheet.Name
Sheets.add After:=Worksheets(Sheets.Count):
Range("A1").Value = Format(Now, "dd.mm.yyyy")
Range("A1").Select
Selection.Value = WorksheetFunction.Text(Selection, "dd.mm.yyyy")
bunka = Range("A1").Value
ActiveSheet.Name = bunka
Worksheets("VZOR").Select
Cells.Select
Selection.Copy
ActiveWindow.SelectedSheets.Visible = False
Sheets(bunka).Activate
Cells.Select
ActiveSheet.Paste
ActiveWindow.Zoom = 55

End Sub

vím, že to bude nějaké if a else, ale nějak mi to do toho nejde zakomponovat 8

Jen, aby to napsalo :
MsgBox "Nelze přidat, jelikož se den už v sešitě nachází", vbExclamation

Díky moc za radu

Jméno
Kontrola
Text
  b i u s img code url hr   1 2 3 4 5 6 7 8 9 10
Anonym(6.8.2020 20:47)#047610
avatar
http://wall.cz/index.php?m=topic&id=16247citovat
elninoslov(7.8.2020 1:59)#047611
elninoslov
V polospánku :
Sub add()
Dim WS As Worksheet, Nazov As String
Nazov = Format(Now, "dd.mm.yyyy")
On Error Resume Next
Set WS = Worksheets(Nazov)
On Error GoTo 0
If Not WS Is Nothing Then MsgBox "Nelze přidat, jelikož se den už v sešitě nachází", vbExclamation: Exit Sub
Worksheets("VZOR").Visible = True
Worksheets("VZOR").Copy After:=Worksheets(Worksheets.Count)
Worksheets("VZOR").Visible = False
Set WS = Worksheets(Worksheets.Count)
WS.Range("A1").Value = Nazov
WS.Name = Nazov
ActiveWindow.Zoom = 55
End Subcitovat
Fantasyk(7.8.2020 16:11)#047614
Fantasyk
tak to elninoslov nefungovalo, ale upravil jsem trochu to tvojeSub add()

Dim WS As Worksheet, Nazev As String
Nazev = Format(Now, "dd.mm.yyyy")
On Error Resume Next
Set WS = Worksheets(Nazev)
On Error GoTo 0
If Not WS Is Nothing Then MsgBox "Nelze pridat, jelikož se aktuální den už v sešite nachází!", vbExclamation: Exit Sub

Dim copr As String
copr = ActiveSheet.Name
Sheets.add After:=Worksheets(Sheets.Count):
Range("A1").Value = Format(Now, "dd.mm.yyyy")
Range("A1").Select
Selection.Value = WorksheetFunction.Text(Selection, "dd.mm.yyyy")
bunka = Range("A1").Value
ActiveSheet.Name = bunka
ActiveWindow.SelectedSheets.Visible = True
Worksheets("VZOR").Select
Cells.Select
Selection.Copy
ActiveWindow.SelectedSheets.Visible = False
Sheets(bunka).Activate
Cells.Select
ActiveSheet.Paste
ActiveWindow.Zoom = 55

End Subcitovat
elninoslov(7.8.2020 18:13)#047615
elninoslov
Pošlite prílohu,nech je jasné odkiaľ makro spúšťate a čo je v listoch. Z toho sa bude dať snáď vydedukovať, čo chcete urobiť.citovat
Fantasyk(7.8.2020 23:37)#047621
Fantasyk

Fantasyk napsal/a:

tak to elninoslov nefungovalo, ale upravil jsem trochu to tvojeSub add()

Dim WS As Worksheet, Nazev As String
Nazev = Format(Now, "dd.mm.yyyy")
On Error Resume Next
Set WS = Worksheets(Nazev)
On Error GoTo 0
If Not WS Is Nothing Then MsgBox "Nelze pridat, jelikož se aktuální den už v sešite nachází!", vbExclamation: Exit Sub

Dim copr As String
copr = ActiveSheet.Name
Sheets.add After:=Worksheets(Sheets.Count):
Range("A1").Value = Format(Now, "dd.mm.yyyy")
Range("A1").Select
Selection.Value = WorksheetFunction.Text(Selection, "dd.mm.yyyy")
bunka = Range("A1").Value
ActiveSheet.Name = bunka
ActiveWindow.SelectedSheets.Visible = True
Worksheets("VZOR").Select
Cells.Select
Selection.Copy
ActiveWindow.SelectedSheets.Visible = False
Sheets(bunka).Activate
Cells.Select
ActiveSheet.Paste
ActiveWindow.Zoom = 55

End Sub


Omyl:
Sheets("VZOR").Visible = True
Misto
ActiveWindow.SelectedSheets.Visible = True

Ale dekuji mockrat..
Ted jsem se vrhl na ještě složitější makro tak jsem zvedavcitovat
Lugr(8.8.2020 12:19)#047622
Lugr
A nestačilo by to jen takhle jednoduše?

Sub Add()

Dim WS As Worksheet
Dim Nazev As String

Nazev = Format(Date, "dd.mm.yyyy")

On Error Resume Next
Set WS = Worksheets(Nazev)
On Error GoTo 0
If Not WS Is Nothing Then MsgBox "Nelze přidat, jelikož se aktuální den už v sešite nachází!", vbExclamation: Exit Sub

Sheets("VZOR").Visible = True
Sheets("VZOR").Copy After:=ActiveSheet
ActiveSheet.Name = Nazev
ActiveWindow.Zoom = 100
ActiveSheet.Range("A1").Select
Sheets("VZOR").Visible = False

End Sub
Příloha: zip47622_add-sheets.zip (19kB, staženo 16x)
citovat
Fantasyk(8.8.2020 13:50)#047624
Fantasyk

lugr napsal/a:

A nestačilo by to jen takhle jednoduše?

Sub Add()

Dim WS As Worksheet
Dim Nazev As String

Nazev = Format(Date, "dd.mm.yyyy")

On Error Resume Next
Set WS = Worksheets(Nazev)
On Error GoTo 0
If Not WS Is Nothing Then MsgBox "Nelze přidat, jelikož se aktuální den už v sešite nachází!", vbExclamation: Exit Sub

Sheets("VZOR").Visible = True
Sheets("VZOR").Copy After:=ActiveSheet
ActiveSheet.Name = Nazev
ActiveWindow.Zoom = 100
ActiveSheet.Range("A1").Select
Sheets("VZOR").Visible = False

End SubPříloha: 47622_add-sheets.zip (19kB, staženo 0x)


jojo to máš pravdu = v jednoduchosti je síla 1
děkujicitovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

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.

Aktivní diskuse

Makro smyčka

MilanKop • 19.4. 10:46

Makro smyčka

elninoslov • 19.4. 9:02

Čas od do

elninoslov • 19.4. 8:46

Čas od do

jarek1111 • 18.4. 13:46

Čas od do

lubo • 18.4. 11:13

Čas od do

jarek1111 • 18.4. 8:32

Čas od do

jarek1111 • 18.4. 8:31