< návrat zpět

MS Excel


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

Zaslal/a 6.8.2020 19:32

Ahojte,
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

Zaslat odpověď >

#047610
avatar
http://wall.cz/index.php?m=topic&id=16247citovat
#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 Sub
citovat
#047614
avatar
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
citovat
#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
#047621
avatar

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
#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 3x)
citovat
#047624
avatar

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 III

Oblíbený formulář Faktura byl vylepšen a rozšířen. Formulář faktura III
Více se dočtete zde.

Aktivní diskuse

VBA vyhledat a zapsat

Stalker • 27.9. 23:02

VBA vyhledat a zapsat

Fantasyk • 27.9. 22:15

VBA vyhledat a zapsat

Stalker • 27.9. 22:04

VBA vyhledat a zapsat

Fantasyk • 27.9. 21:03

vyhledávání s maticí

Fantasyk • 26.9. 11:35

Automatické doplnění

marjankaj • 25.9. 14:27

Automatické doplnění

Dingo • 25.9. 14:25