-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Fferi50
Topikgazda
válasz
istvankeresz
#50013
üzenetére
Szia!
Inkább ezt próbáld ki, mert a másik nem igazán jó:Sub akarmi()
Dim answer As Integer, wsFound As Boolean
Dim wbSearch As Workbook, wsSearch As Worksheet
wsfound = True
On Error Resume Next
Set wsSearch = Sheets(Textbox11.Value)
If Err = 0 Then
'ha van már ilyen munkalap, akkor feltesszük a kérdést
answer = MsgBox("Ilyen nevű munkatárs már rögzítve! Biztos, hogy folytatod a rögzítést?", vbQuestion + vbYesNo + vbDefaultButton2, "Munkatárs rögzítése")
If answer = vbYes Then wsSearch.Copy after:=Sheets("Havi_TEMPLATE"): wsFound = True
Else
Err = 0
Sheets("Szemely_TEMPLATE").Copy after:=Sheets("Havi_TEMPLATE")
ActiveSheet.Name = Textbox11.Value
End If
On Error GoTo 0
If wsFound Then
With ActiveSheet
.Range("A2") = Textbox11.Value & " " & ComboBox7.Value
.Range("B2") = TextBox12.Value
.Range("C2") = TextBox13.Value
.Range("D2") = TextBox14.Value
End With
MsgBox "Munkatárs sikeresen rögzitve! Kérlek zárd be és nyisd meg újra a programot!"
End If
Textbox11.Value = ""
ComboBox7.Value = ""
TextBox12.Value = ""
TextBox13.Value = ""
TextBox14.Value = ""
'Sheets(xx).Activate az alapmunkalap aktíválása, ha szükséges.
End Sub
Egy kis magyarázat hozzá:
Nem kell végigpörgetni a munkalapokat, mivel a vba hibakezeléssel megállapítható, ha van már ilyen munkalap => a Set után ha nincs hiba, akkor van már. Amennyiben ugyanolyan nevű új személy van, akkor ezt a munkalapot másoljuk, aminek az lesz az eredménye, hogy az Excel automatikusan ad egy sorszámot a névhez! ezzel nekünk nem kell foglalkozni.
Ha nincs, akkor másoljuk a Templatet.
Mivel a másolt munkalap lesz az aktív, utána beírhatjuk a szükséges adatokat az új munkalapra.
Remélem sikerülni fog.
Üdv.
Új hozzászólás Aktív témák
- Kínai és egyéb olcsó órák topikja
- SSD kibeszélő
- HiFi műszaki szemmel - sztereó hangrendszerek
- One otthoni szolgáltatások (TV, internet, telefon)
- Tőzsde és gazdaság
- Spórolós topik
- Intel Core Ultra 3, Core Ultra 5, Ultra 7, Ultra 9 "Arrow Lake" LGA 1851
- Google Chrome
- Suzuki topik
- Kerékpárosok, bringások ide!
- További aktív témák...
- Játékkulcsok ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok : (12.20.)
- Gyermek PC játékok
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Apple iPhone XR 64GB, Kártyafüggetlen, 1 Év Garanciával
- Telefon felvásárlás!! iPhone 11/iPhone 11 Pro/iPhone 11 Pro Max
- Samsung Galaxy S24 Ultra 120 Hz Dynamic AMOLED 2X, beépített S Pen, Galaxy AI 12/256 GB
- BESZÁMÍTÁS! ASUS H510M i5 11400F 32GB DDR4 512GB SSD RX 6750 XT 12GB Zalman T4 Plus GIGABYTE 750W
- SanDisk Extreme Portable 8TB (SDSSDE61-8T00-G25)
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopszaki Kft.
Város: Budapest
Fferi50
