TextBox soll bei Masken start leer sein, Daten werden von der vorherigen Eingabe übernommen

  • Excel

Es gibt 20 Antworten in diesem Thema. Der letzte Beitrag () ist von Johanne.

    TextBox soll bei Masken start leer sein, Daten werden von der vorherigen Eingabe übernommen

    Hallo Experten,

    ich bitte um eure Hilfe, da ich Anfänger bin.

    Ich habe folgendes Problem:
    In der Datei befinden sich 2 Tabellenblätter (TB); Inventar und Eingabe.
    Wenn ich mich auf dem TB Eingabe befinde und den Button "Eingabe starten" drücke, öffnet sich wie gewünscht, eine Eingabemaske. Dort klicke ich dann auf den Button "Kalender starten" und bekomme ein weiteres Fenster mit einem Kalender. Bis hier hin läuft alles gut und korrekt.

    Wenn ich das Fenster nach erfolgreicher Eingabe mit dem Button "schließen" schließe, dann sehe ich die erfassten Daten. Ich gehe dann erneut auf das TB Eingabe und wähle z.B. die Zubehör Eingabe oder die Reparatur Eingabe aus.

    An dieser Stelle steht das gerade erfasste Datum in der TextBox rechts neben "Kalender starten". Diese TextBox sollte mit Start der Maske leer sein.
    Wenn ich die Maske schließe und erneut aufrufe, dann ist sie leer, aber vielleicht geht es auch, dass sie bei jedem Start leer ist.
    Im Spoiler könnt ihr sehen, dass ich bereits nach einer Lösung gesucht habe, die nur leider nicht funktioniert.

    Daher bitte ich um eure Hilfe.

    Dankeschön


    Inventar_Eingabe_Maske

    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Option Explicit
    2. Private Sub Button_Schließen_Click()
    3. 'TextBox_Lieferdatum leeren
    4. TextBox_Lieferdatum = ""
    5. 'Eingabefenster schließen
    6. Unload Inventar_Eingabe_Maske
    7. End Sub
    8. Private Sub Button_Eingabe_Click()
    9. 'Eingaben der Schaltfläche in die Arbeitsmappe übernehmen
    10. Dim last As Long
    11. last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    12. 'Inventarnummer
    13. Cells(last, 1).Value = TextBox_Inventarnummer
    14. 'Bezeichnung
    15. Cells(last, 2).Value = TextBox_Bezeichnung
    16. 'BezeichnungZusatz
    17. Cells(last, 3).Value = TextBox_BezeichnungZusatz
    18. 'Invertarrubrik
    19. Cells(last, 4).Value = ComboBox_Inventarrubrik
    20. 'Auftragsnummer
    21. Cells(last, 5).Value = TextBox_Auftragsnummer
    22. 'KostenBrutto
    23. Cells(last, 6).Value = TextBox_KostenBrutto
    24. 'Lieferdatum
    25. Cells(last, 7).Value = TextBox_Lieferdatum
    26. 'Seriennummer
    27. Cells(last, 8).Value = TextBox_Seriennummer
    28. 'Bundnummer / Inventarnummer ALT
    29. Cells(last, 9).Value = TextBox_Bundnummer
    30. 'Hersteller
    31. Cells(last, 10).Value = TextBox_Hersteller
    32. 'Lieferant
    33. Cells(last, 11).Value = TextBox_Lieferant
    34. 'Rechnungsnummer
    35. Cells(last, 12).Value = TextBox_Rechnungsnummer
    36. 'Bemerkung
    37. Cells(last, 13).Value = TextBox_Bemerkung
    38. 'Verwaltungskontenrahmen
    39. Cells(last, 14).Value = TextBox_Verwaltungskontenrahmen
    40. 'Organisationseinheit
    41. Cells(last, 15).Value = TextBox_Organisationseinheit
    42. 'Nutzer
    43. Cells(last, 16).Value = TextBox_Nutzer
    44. 'Standort
    45. Cells(last, 17).Value = TextBox_Standort
    46. 'GebäudeNr
    47. Cells(last, 18).Value = TextBox_GebäudeNr
    48. 'Etage
    49. Cells(last, 19).Value = TextBox_Etage
    50. 'RaumNr
    51. Cells(last, 20).Value = TextBox_RaumNr
    52. MsgBox "Eingabe Erfolgreich"
    53. End Sub
    54. Private Sub CommandButton1_Click()
    55. Kalender_Maske.Show
    56. End Sub
    57. Private Sub TextBox_Inventarnummer_Enter()
    58. 'aktivierte Zelle gelb färben
    59. TextBox_Inventarnummer.BackColor = vbYellow
    60. End Sub
    61. Private Sub TextBox_Inventarnummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    62. 'deaktivierte Zelle weiß färben
    63. TextBox_Inventarnummer.BackColor = vbWhite
    64. End Sub
    65. Private Sub TextBox_Bezeichnung_Enter()
    66. 'aktivierte Zelle gelb färben
    67. TextBox_Bezeichnung.BackColor = vbYellow
    68. End Sub
    69. Private Sub TextBox_Bezeichnung_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    70. 'deaktivierte Zelle weiß färben
    71. TextBox_Bezeichnung.BackColor = vbWhite
    72. End Sub
    73. Private Sub TextBox_BezeichnungZusatz_Enter()
    74. 'aktivierte Zelle gelb färben
    75. TextBox_BezeichnungZusatz.BackColor = vbYellow
    76. End Sub
    77. Private Sub TextBox_BezeichnungZusatz_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    78. 'deaktivierte Zelle weiß färben
    79. TextBox_BezeichnungZusatz.BackColor = vbWhite
    80. End Sub
    81. Private Sub ComboBox_Inventarrubrik_Enter()
    82. 'aktivierte Zelle gelb färben
    83. ComboBox_Inventarrubrik.BackColor = vbYellow
    84. End Sub
    85. Private Sub ComboBox_Inventarrubrik_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    86. 'deaktivierte Zelle weiß färben
    87. ComboBox_Inventarrubrik.BackColor = vbWhite
    88. End Sub
    89. Private Sub TextBox_Auftragsnummer_Enter()
    90. 'aktivierte Zelle gelb färben
    91. TextBox_Auftragsnummer.BackColor = vbYellow
    92. End Sub
    93. Private Sub TextBox_Auftragsnummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    94. 'deaktivierte Zelle weiß färben
    95. TextBox_Auftragsnummer.BackColor = vbWhite
    96. End Sub
    97. Private Sub TextBox_KostenBrutto_Enter()
    98. 'aktivierte Zelle gelb färben
    99. TextBox_KostenBrutto.BackColor = vbYellow
    100. End Sub
    101. Private Sub TextBox_KostenBrutto_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    102. 'deaktivierte Zelle weiß färben
    103. TextBox_KostenBrutto.BackColor = vbWhite
    104. End Sub
    105. Private Sub TextBox_Lieferdatum_Enter()
    106. 'TextBox_Lieferdatum leeren
    107. TextBox_Lieferdatum.Value = ""
    108. End Sub
    109. Private Sub TextBox_Lieferdatum_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    110. 'TextBox_Lieferdatum leeren
    111. TextBox_Lieferdatum.Value = ""
    112. End Sub
    113. Private Sub TextBox_Seriennummer_Enter()
    114. 'aktivierte Zelle gelb färben
    115. TextBox_Seriennummer.BackColor = vbYellow
    116. End Sub
    117. Private Sub TextBox_Seriennummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    118. 'deaktivierte Zelle weiß färben
    119. TextBox_Seriennummer.BackColor = vbWhite
    120. End Sub
    121. Private Sub TextBox_Bundnummer_Enter()
    122. 'aktivierte Zelle gelb färben
    123. TextBox_Bundnummer.BackColor = vbYellow
    124. End Sub
    125. Private Sub TextBox_Bundnummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    126. 'deaktivierte Zelle weiß färben
    127. TextBox_Bundnummer.BackColor = vbWhite
    128. End Sub
    129. Private Sub TextBox_Hersteller_Enter()
    130. 'aktivierte Zelle gelb färben
    131. TextBox_Hersteller.BackColor = vbYellow
    132. End Sub
    133. Private Sub TextBox_Hersteller_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    134. 'deaktivierte Zelle weiß färben
    135. TextBox_Hersteller.BackColor = vbWhite
    136. End Sub
    137. Private Sub TextBox_Lieferant_Enter()
    138. 'aktivierte Zelle gelb färben
    139. TextBox_Lieferant.BackColor = vbYellow
    140. End Sub
    141. Private Sub TextBox_Lieferant_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    142. 'deaktivierte Zelle weiß färben
    143. TextBox_Lieferant.BackColor = vbWhite
    144. End Sub
    145. Private Sub TextBox_Rechnungsnummer_Enter()
    146. 'aktivierte Zelle gelb färben
    147. TextBox_Rechnungsnummer.BackColor = vbYellow
    148. End Sub
    149. Private Sub TextBox_Rechnungsnummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    150. 'deaktivierte Zelle weiß färben
    151. TextBox_Rechnungsnummer.BackColor = vbWhite
    152. End Sub
    153. Private Sub TextBox_Bemerkung_Enter()
    154. 'aktivierte Zelle gelb färben
    155. TextBox_Bemerkung.BackColor = vbYellow
    156. End Sub
    157. Private Sub TextBox_Bemerkung_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    158. 'deaktivierte Zelle weiß färben
    159. TextBox_Bemerkung.BackColor = vbWhite
    160. End Sub
    161. Private Sub TextBox_Verwaltungskontenrahmen_Enter()
    162. 'aktivierte Zelle gelb färben
    163. TextBox_Verwaltungskontenrahmen.BackColor = vbYellow
    164. End Sub
    165. Private Sub TextBox_Verwaltungskontenrahmen_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    166. 'deaktivierte Zelle weiß färben
    167. TextBox_Verwaltungskontenrahmen.BackColor = vbWhite
    168. End Sub
    169. Private Sub TextBox_Organisationseinheit_Enter()
    170. 'aktivierte Zelle gelb färben
    171. TextBox_Organisationseinheit.BackColor = vbYellow
    172. End Sub
    173. Private Sub TextBox_Organisationseinheit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    174. 'deaktivierte Zelle weiß färben
    175. TextBox_Organisationseinheit.BackColor = vbWhite
    176. End Sub
    177. Private Sub TextBox_Nutzer_Enter()
    178. 'aktivierte Zelle gelb färben
    179. TextBox_Nutzer.BackColor = vbYellow
    180. End Sub
    181. Private Sub TextBox_Nutzer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    182. 'deaktivierte Zelle weiß färben
    183. TextBox_Nutzer.BackColor = vbWhite
    184. End Sub
    185. Private Sub TextBox_Standort_Enter()
    186. 'aktivierte Zelle gelb färben
    187. TextBox_Standort.BackColor = vbYellow
    188. End Sub
    189. Private Sub TextBox_Standort_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    190. 'deaktivierte Zelle weiß färben
    191. TextBox_Standort.BackColor = vbWhite
    192. End Sub
    193. Private Sub TextBox_GebäudeNr_Enter()
    194. 'aktivierte Zelle gelb färben
    195. TextBox_GebäudeNr.BackColor = vbYellow
    196. End Sub
    197. Private Sub TextBox_GebäudeNr_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    198. 'deaktivierte Zelle weiß färben
    199. TextBox_GebäudeNr.BackColor = vbWhite
    200. End Sub
    201. Private Sub TextBox_Etage_Enter()
    202. 'aktivierte Zelle gelb färben
    203. TextBox_Etage.BackColor = vbYellow
    204. End Sub
    205. Private Sub TextBox_Etage_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    206. 'deaktivierte Zelle weiß färben
    207. TextBox_Etage.BackColor = vbWhite
    208. End Sub
    209. Private Sub TextBox_RaumNr_Enter()
    210. 'aktivierte Zelle gelb färben
    211. TextBox_RaumNr.BackColor = vbYellow
    212. End Sub
    213. Private Sub TextBox_RaumNr_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    214. 'deaktivierte Zelle weiß färben
    215. TextBox_RaumNr.BackColor = vbWhite
    216. End Sub
    217. Private Sub UserForm_Initialize()
    218. 'Inventarnummer
    219. TextBox_Inventarnummer = ""
    220. 'Bezeichnung
    221. TextBox_Bezeichnung = ""
    222. 'BezeichnungZusatz
    223. TextBox_BezeichnungZusatz = ""
    224. 'Invertarrubrik
    225. ComboBox_Inventarrubrik = ""
    226. With ComboBox_Inventarrubrik
    227. .AddItem "Bedampfungsanlage"
    228. .AddItem "Brutschränke/Brutgeräte"
    229. .AddItem "Bunsenbrenner"
    230. .AddItem "Büroeinrichtung"
    231. .AddItem "Bürotechnik"
    232. .AddItem "Cycler/PCR-Systeme"
    233. .AddItem "Datenverarbeitung"
    234. .AddItem "Dosierkleingeräte"
    235. .AddItem "Druckminderer"
    236. .AddItem "Durchflusszytometer"
    237. .AddItem "Entsorgung"
    238. .AddItem "Erste-Hilfe"
    239. .AddItem "Fahrzeuge"
    240. .AddItem "Filtrationsgeräte"
    241. .AddItem "Fischhälterung"
    242. .AddItem "Folienschweißgeräte"
    243. .AddItem "Fotografiegeräte+Zubehör"
    244. .AddItem "Gelauswertesystem"
    245. .AddItem "Gelgeräte"
    246. .AddItem "Histologie"
    247. .AddItem "Küchengeräte"
    248. .AddItem "Küchenzeile"
    249. .AddItem "Laborhandgeräte"
    250. .AddItem "Labormöbel"
    251. .AddItem "Laborreinigungsgeräte"
    252. .AddItem "Lagerregale"
    253. .AddItem "Leitern"
    254. .AddItem "Messgeräte Labor"
    255. .AddItem "Messgeräte allgemein"
    256. .AddItem "Mikroskope"
    257. .AddItem "Photometer/ELISA-Reader"
    258. .AddItem "Pipetten"
    259. .AddItem "Pipettierhilfen"
    260. .AddItem "Pipettierroboter"
    261. .AddItem "Präsentationsgegenstände"
    262. .AddItem "Reinig.-u. Desinfektionsautomat"
    263. .AddItem "Reinstwasseranlage/Ionenaust."
    264. .AddItem "Rührgeräte"
    265. .AddItem "Schüttelgeräte"
    266. .AddItem "Separator"
    267. .AddItem "Sequenzierungssysteme"
    268. .AddItem "Sicherheitswerkbänke"
    269. .AddItem "Sonstiges"
    270. .AddItem "Sterilisator/Autoklav"
    271. .AddItem "Strahlenschutz"
    272. .AddItem "Stromversorgungsgeräte"
    273. .AddItem "Telekommunikation"
    274. .AddItem "Thermomixer+Wechselblöcke"
    275. .AddItem "Tiefkühlmöbel+Zubehör"
    276. .AddItem "Tierhaltung"
    277. .AddItem "Transportgeräte"
    278. .AddItem "Ultraschallgeräte"
    279. .AddItem "Vakuumpumpen/Kompressor"
    280. .AddItem "Wasserbad/Thermostate"
    281. .AddItem "Weidezaunanlage"
    282. .AddItem "Werkstattausstattung"
    283. .AddItem "Wohnmöbel"
    284. .AddItem "Wäscherei"
    285. .AddItem "Zellaufschlussgeräte"
    286. .AddItem "Zentrifugen+Rotore"
    287. .AddItem "allg. Reinigungsgeräte"
    288. .AddItem "sonst. Heiz-, Wärme-, Kältegeräte"
    289. End With
    290. 'Auftragsnummer
    291. TextBox_Auftragsnummer = ""
    292. 'KostenBrutto
    293. TextBox_KostenBrutto = ""
    294. 'Lieferdatum
    295. TextBox_Lieferdatum.Text = ""
    296. 'Seriennummer
    297. TextBox_Seriennummer = ""
    298. 'Bundnummer / Inventarnummer ALT
    299. TextBox_Bundnummer = ""
    300. 'Hersteller
    301. TextBox_Hersteller = ""
    302. 'Lieferant
    303. TextBox_Lieferant = ""
    304. 'Rechnungsnummer
    305. TextBox_Rechnungsnummer = ""
    306. 'Bemerkung
    307. TextBox_Bemerkung = ""
    308. 'Verwaltungskontenrahmen
    309. TextBox_Verwaltungskontenrahmen = ""
    310. 'Organisationseinheit
    311. TextBox_Organisationseinheit = ""
    312. 'Nutzer
    313. TextBox_Nutzer = ""
    314. 'Standort
    315. TextBox_Standort = ""
    316. 'GebäudeNr
    317. TextBox_GebäudeNr = ""
    318. 'Etage
    319. TextBox_Etage = ""
    320. 'RaumNr
    321. TextBox_RaumNr = ""
    322. End Sub
    Dateien
    Hey

    Normal musst du solche Events immer mit dem "Masken" starten machen.
    Sprich, immer wenn die Userform gestartet wird soll ein Makro abgerufen werden

    VB.NET-Quellcode

    1. Sub Userform_Initialise 'Statt Userform dann warscheinlich Kalender_Maske
    2. 'Auftragsnummer
    3. TextBox_Auftragsnummer = ""
    4. 'KostenBrutto
    5. TextBox_KostenBrutto = ""
    6. 'Lieferdatum
    7. TextBox_Lieferdatum.Text = ""
    8. 'Seriennummer
    9. TextBox_Seriennummer = ""
    10. 'Bundnummer / Inventarnummer ALT
    11. TextBox_Bundnummer = ""
    12. 'Hersteller
    13. TextBox_Hersteller = ""
    14. 'Lieferant
    15. TextBox_Lieferant = ""
    16. 'Rechnungsnummer
    17. TextBox_Rechnungsnummer = ""
    18. 'Bemerkung
    19. TextBox_Bemerkung = ""
    20. 'Verwaltungskontenrahmen
    21. TextBox_Verwaltungskontenrahmen = ""
    22. 'Organisationseinheit
    23. TextBox_Organisationseinheit = ""
    24. 'Nutzer
    25. TextBox_Nutzer = ""
    26. 'Standort
    27. TextBox_Standort = ""
    28. 'GebäudeNr
    29. TextBox_GebäudeNr = ""
    30. 'Etage
    31. TextBox_Etage = ""
    32. 'RaumNr
    33. TextBox_RaumNr = ""
    34. End Sub


    Stat dem Userform musst du den Namen deiner Userform nehmen
    Hey,
    Danke für den Tipp.
    Ich habe es gerade ausprobiert (d.h. ich habe das UserForm_Initialize durch Kalender_Maske_Initialize ersetzt.)

    Leider ändert sich dadurch nichts. Wenn ich Eingabe_Maske starte steht dort das Datum von der vorherigen Maske. (z.b. von der Zubehöreingabe oder Reparatur Maske)

    Oder habe ich dich falsch verstanden?
    Ich klicke auf die Eingabe Buttons im Tabellenblatt: Eingabe und dann auf die Schaltfläche Kalender Starten und da rechts steht das Datum, welches ich mit dem vorherigen Kalender ausgewählt habe.
    Das

    VB.NET-Quellcode

    1. UserForm_Initialize
    bedeutet alle Makros die sich in diesem Sub befinden werden beim starten dieser Userform ausgeführt

    also musst du das Makro bei der Eingabe_Maske_Initialize einfügen

    Also bei der Userform (Eingabe_Masek) folgendes Makro

    VB.NET-Quellcode

    1. Sub Eingabe_Maske_Initialize '
    2. Textbox.text = "" ' Hier halt den Namen der textbox verwenden die leer sein soll
    3. End Sub

    meinst du so?

    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Private Sub Inventar_Eingabe_Maske_Initialize()
    2. 'Inventarnummer
    3. TextBox_Inventarnummer = ""
    4. 'Bezeichnung
    5. TextBox_Bezeichnung = ""
    6. 'BezeichnungZusatz
    7. TextBox_BezeichnungZusatz = ""
    8. 'Invertarrubrik
    9. ComboBox_Inventarrubrik = ""
    10. With ComboBox_Inventarrubrik
    11. .AddItem "Bedampfungsanlage"
    12. .AddItem "Brutschränke/Brutgeräte"
    13. .AddItem "Bunsenbrenner"
    14. .AddItem "Büroeinrichtung"
    15. .AddItem "Bürotechnik"
    16. .AddItem "Cycler/PCR-Systeme"
    17. .AddItem "Datenverarbeitung"
    18. .AddItem "Dosierkleingeräte"
    19. .AddItem "Druckminderer"
    20. .AddItem "Durchflusszytometer"
    21. .AddItem "Entsorgung"
    22. .AddItem "Erste-Hilfe"
    23. .AddItem "Fahrzeuge"
    24. .AddItem "Filtrationsgeräte"
    25. .AddItem "Fischhälterung"
    26. .AddItem "Folienschweißgeräte"
    27. .AddItem "Fotografiegeräte+Zubehör"
    28. .AddItem "Gelauswertesystem"
    29. .AddItem "Gelgeräte"
    30. .AddItem "Histologie"
    31. .AddItem "Küchengeräte"
    32. .AddItem "Küchenzeile"
    33. .AddItem "Laborhandgeräte"
    34. .AddItem "Labormöbel"
    35. .AddItem "Laborreinigungsgeräte"
    36. .AddItem "Lagerregale"
    37. .AddItem "Leitern"
    38. .AddItem "Messgeräte Labor"
    39. .AddItem "Messgeräte allgemein"
    40. .AddItem "Mikroskope"
    41. .AddItem "Photometer/ELISA-Reader"
    42. .AddItem "Pipetten"
    43. .AddItem "Pipettierhilfen"
    44. .AddItem "Pipettierroboter"
    45. .AddItem "Präsentationsgegenstände"
    46. .AddItem "Reinig.-u. Desinfektionsautomat"
    47. .AddItem "Reinstwasseranlage/Ionenaust."
    48. .AddItem "Rührgeräte"
    49. .AddItem "Schüttelgeräte"
    50. .AddItem "Separator"
    51. .AddItem "Sequenzierungssysteme"
    52. .AddItem "Sicherheitswerkbänke"
    53. .AddItem "Sonstiges"
    54. .AddItem "Sterilisator/Autoklav"
    55. .AddItem "Strahlenschutz"
    56. .AddItem "Stromversorgungsgeräte"
    57. .AddItem "Telekommunikation"
    58. .AddItem "Thermomixer+Wechselblöcke"
    59. .AddItem "Tiefkühlmöbel+Zubehör"
    60. .AddItem "Tierhaltung"
    61. .AddItem "Transportgeräte"
    62. .AddItem "Ultraschallgeräte"
    63. .AddItem "Vakuumpumpen/Kompressor"
    64. .AddItem "Wasserbad/Thermostate"
    65. .AddItem "Weidezaunanlage"
    66. .AddItem "Werkstattausstattung"
    67. .AddItem "Wohnmöbel"
    68. .AddItem "Wäscherei"
    69. .AddItem "Zellaufschlussgeräte"
    70. .AddItem "Zentrifugen+Rotore"
    71. .AddItem "allg. Reinigungsgeräte"
    72. .AddItem "sonst. Heiz-, Wärme-, Kältegeräte"
    73. End With
    74. 'Auftragsnummer
    75. TextBox_Auftragsnummer = ""
    76. 'KostenBrutto
    77. TextBox_KostenBrutto = ""
    78. 'Lieferdatum
    79. TextBox_Lieferdatum.Text = ""
    80. 'Seriennummer
    81. TextBox_Seriennummer = ""
    82. 'Bundnummer / Inventarnummer ALT
    83. TextBox_Bundnummer = ""
    84. 'Hersteller
    85. TextBox_Hersteller = ""
    86. 'Lieferant
    87. TextBox_Lieferant = ""
    88. 'Rechnungsnummer
    89. TextBox_Rechnungsnummer = ""
    90. 'Bemerkung
    91. TextBox_Bemerkung = ""
    92. 'Verwaltungskontenrahmen
    93. TextBox_Verwaltungskontenrahmen = ""
    94. 'Organisationseinheit
    95. TextBox_Organisationseinheit = ""
    96. 'Nutzer
    97. TextBox_Nutzer = ""
    98. 'Standort
    99. TextBox_Standort = ""
    100. 'GebäudeNr
    101. TextBox_GebäudeNr = ""
    102. 'Etage
    103. TextBox_Etage = ""
    104. 'RaumNr
    105. TextBox_RaumNr = ""
    106. End Sub


    Habe es ausprobiert, aber wenn ich eine andere Maske über das Tabellenblatt Eingabe anklicke, steht das Datum immer noch da.
    Hmm eventuell reden wir aneinander vorbei :)
    Ich versuch es mal zu verstehen....

    Du hast eine Excel wo 2 Tabellenblätter sind, darauf sind Buttons wo dann Userfromen starten oder ?

    Meine Fragen wären:
    Wieviele Userformen hast du ?
    Auf welcher Userform befindet sich die Textbox die geleert werden soll ?
    wann genau so der "Event" ausgelöst werden das deine Textbox geleert wird ?
    Vielleicht habe ich es auch falsch erklärt, aber so wie du es "gerade" beschrieben hast, ist es richtig.

    Du hast eine Excel wo 2 Tabellenblätter sind, darauf sind Buttons wo dann Userfromen starten oder ?

    Ja, ich habe 2 Tabellenblätter. In Tabellenblatt Eingabe befinden sich 5 Buttons zum Starten von Userformen


    Wieviele Userformen hast du ?

    6, da die Kalender_Maske auch eine Userform ist


    Auf welcher Userform befindet sich die Textbox die geleert werden soll ?

    Auf allen 5 (Kalender_Maske ausgenommen) befindet sich ein CommandButton: "Kalender starten"


    wann genau so der "Event" ausgelöst werden das deine Textbox geleert wird ?

    Immer wenn ich eine Userform öffne, damit es bei der Eingabe der neuen Daten nicht zur "Verwirrung" kommt und man das "neue" Datum vielleicht nicht einträgt.
    Wenn ich das dann richtig verstanden habe müsstest du den Userform_Initialize auf jeder form haben.

    Aber ahcte darauf, wenn du auf eine andere Userform zugreifen willst mit einem Befehl musst du diese Userform auch aufrufen.

    VB.NET-Quellcode

    1. Sub Eingabe_Maske_Initialize '
    2. NAMEUserform1.TextboxNAME.text = " "
    3. NAMEUserform2.TextboxNAME.text = " "
    4. NAMEUserform3.TextboxNAME.text = " "
    5. NAMEUserform4.TextboxNAME.text = " "
    6. NAMEUserform5.TextboxNAME.text = " "
    7. End Sub


    Dieses Makro würde bedeuten, sobald die Userform Eingabe Maske gestartet wird werden auf 5 anderen Userformen die Textboxen geleert
    Moin,
    Danke für deine Hilfe und Mühe.

    Wenn ich das dann richtig verstanden habe müsstest du den Userform_Initialize auf jeder form haben.

    Ja habe ich, siehe "kurz" (… = manches rausgelassen, weil es zu lang wäre) Spoiler:

    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Inventar_Eingabe_Maske
    2. Private Sub Inventar_Eingabe_Maske_Initialize()
    3. 'Inventarnummer
    4. TextBox_Inventarnummer = ""
    5. 'Bezeichnung
    6. TextBox_Bezeichnung = ""
    7. 'BezeichnungZusatz
    8. TextBox_BezeichnungZusatz = ""
    9. 'Lieferdatum
    10. TextBox_Lieferdatum.Text = ""
    11. End Sub
    12. ----------------------------------------------------------------------------
    13. Zubehör_Maske
    14. Private Sub UserForm_Initialize()
    15. 'Kaufdatum des Zubehörs
    16. TextBox_KaufdatumDesZubehörs = ""
    17. End Sub
    18. ----------------------------------------------------------------------------
    19. WartungsDurchsichts_Maske
    20. Private Sub UserForm_Initialize()
    21. 'Wartungs- / Durchsichtsdatum
    22. TextBox_WartungsDurchsichtsdatum = ""
    23. End Sub
    24. ---------------------------------------------------------------------------
    25. Reparatur_Maske
    26. Private Sub UserForm_Initialize()
    27. 'Reparatur Datum
    28. TextBox_ReparaturDatum = ""
    29. End Sub
    30. ----------------------------------------------------------------------------------------------
    31. Aussonderungs_Maske
    32. Private Sub UserForm_Initialize()
    33. 'TagDerBeräumung
    34. TextBox_TagDerBeräumung.Text = ""
    35. ...
    36. End Sub


    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Oder ist mein Code an dieser Stelle "schlichtweg" falsch, sodass es nicht funktionieren kann.


    Folgendes habe ich gemacht:

    1. den Code in den vorhandenen Text einzubauen: ohne Erfolg
    2. Inventar_Eingabe_Maske_Inititialize "ausgeschnitten" und an den Anfang wieder eingefügt: ohne Erfolg.
    3. Deinen Code in die Tabelle2 (Eingaben) eingefügt: ohne Erfolg
    4. Deinen Code in diese Arbeitsmappe eingefügt: ohne Erfolg
    5. Neues Modul eingefügt: Eingaben; und dieses Makro meinem vorhandenen Button: Eingabe starten zugewiesen: ohne Erfolg, da ich manches nicht definiert hatte und er mein eigentliches Eingabefenster nicht mehr aufrief.
    6. Auf dem Tabellenblatt: Eingaben, einen neuen Button: Eingaben Starten erstellt: mit Erfolg.

    Nun ist nur das Problem, dass die Personen, die die Eingaben später machen, immer zuerst auf den "neuen Button: Eingaben starten" drücken müssten und dann auf z.B. den Button Inventareingabe starten (vorher hieß der Button: "Eingabe starten") Kann ich deinen Code irgendwie anders in meine ...initialize unterbringen, damit es funktioniert?

    Oder kann man die ersten Button mit den Makros auch mit dem neuen Button verbinden?
    Ich meine: Wenn ich den Button Eingaben starten anklicke, dass dann die anderen Button erscheinen und ich für die jeweilige Eingabe den jeweiligen Button drücke.

    Das wäre dann zwar ein Button mehr, aber sonst bin ich mit meinem Latein am Ende.
    Ich habe sogar die ...Initialize() an den Anfang gesetzt, weil ich dachte, dass die Reihenfolge, wie ich programmiere, auch wichtig ist.


    Aber achte darauf, wenn du auf eine andere Userform zugreifen willst mit einem Befehl musst du diese Userform auch aufrufen.

    Wie genau meinst du das?
    Eine Verbindung mit einem Makro herstellen, wie ich das schon versucht habe?

    Vielen Dank für Deine Hilfe und Mühe

    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „Johanne“ ()

    Ok scheinbar hatte ich einen Wurm drin, Excel ist schon etwas her

    Mach es einfach mit folgendem makro

    VB.NET-Quellcode

    1. Private Sub UserForm_Initialize()
    2. Msgbox "Dieses Makro kommt wenn die Form geöffnet wird"
    3. End Sub


    Egal wie die Form heisst, sobald der Private Sub UserForm_Initialize() in dieser Form steht wird auch das Makro das sich darin befindet abgerufen.

    Hab es gerade selber getestet ;)

    Oder kann man die ersten Button mit den Makros auch mit dem neuen Button verbinden?

    Ich meine: Wenn ich den Button Eingaben starten anklicke, dass dann die
    anderen Button erscheinen und ich für die jeweilige Eingabe den
    jeweiligen Button drücke.


    Wenn du ein Makro für mehr Buttons nehmen willst erstelle ein Modul und setzte den Sub auf Public und nicht auf Private

    VB.NET-Quellcode

    1. Public Sub Test()
    2. Msgbox "Ich bin in jeder Form Verfügbar"
    3. End Sub


    Wenn du jetzt deinen Button Sub oder Initialize sub auf der Userform hast kannst du dieses Makro gant einfach abrufen mit Call

    VB.NET-Quellcode

    1. Private Sub UserForm_Initialize()
    2. 'Es wird das Makro Test abgerufen und ausgeführt
    3. Call Test
    4. End Sub
    5. '---------------------
    6. Private Sub Button_Eingabe_Click()
    7. 'Es wird das Makro Test abgerufen und ausgeführt
    8. Call Test
    9. End Sub


    Gewöhn
    dir am besten an wenn du mit Userformen arbeitest bestimmte Makros die
    du öfters aufrufen musst in ein Modul als Public zu setzen

    Erspart dir eine große schreib und kopier arbeit

    Was
    ich auch gerne mache wenn ich zb. wie bei dir Userform initialize habe,
    schreibe ich nicht gleich mein Makros rein sondern immer nur eine
    Messagebox, dann sehe ich sofort ob alles passt

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Animal2k“ ()

    Moin,

    ich habe dein erstes Makro in einer leeren Maske ausprobiert und es funktioniert.

    Dein zweites Makro für die mehreren Buttons konnte ich auch übernehmen und es funktioniert.

    Unten verlinke ich meine Maske, dann kannst du dir die Änderung angucken.

    Button Makro: Start der Eingaben (im Modul)
    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Option Explicit
    2. Public Sub Userform1Starten()
    3. 'Ein Tabellenblatt Aktivieren
    4. Worksheets("Inventar").Activate
    5. 'Start_Maske starten
    6. Start_Maske.Show
    7. End Sub
    8. Public Sub Inventar_Eingabe_Maske_Initialize()
    9. 'TextBox_Lieferdatum in Inventar_Eingabe_Maske leeren
    10. Inventar_Eingabe_Maske.TextboxLieferdatum.Text = ""
    11. End Sub
    12. Public Sub Zubehör_Maske_Initialize()
    13. 'TextBox_KaufdatumDesZubehörs in Zubehör_Maske leeren
    14. Zubehör_Maske.TextBox_KaufdatumDesZubehörs.Text = ""
    15. End Sub
    16. Public Sub WartungsDurchsichts_Maske_Initialize()
    17. 'TextBox_WartungsDurchsichtsdatum_Maske in WartungsDurchsichts_Maske leeren
    18. WartungsDurchsichts_Maske.TextBox_WartungsDurchsichtsdatum.Text = ""
    19. End Sub
    20. Public Sub Reparatur_Maske_Initialize()
    21. 'TextBox_ReparaturDatum in Reparatur_Maske leeren
    22. Reparatur_Maske.TextBox_ReparaturDatum.Text = ""
    23. End Sub
    24. Public Sub Aussonderungs_Maske_Initialize()
    25. 'TextBox_TagDerBeräumung in Aussonderungs_Maske leeren
    26. Aussonderungs_Maske.TextBox_TagDerBeräumung.Text = ""
    27. End Sub
    28. Public Sub Kalender_Maske_Initialize()
    29. 'TB_Datum1 in Kalender_Maske leeren
    30. Kalender_Maske.TB_Datum1.Text = ""
    31. End Sub



    Start Maske (bei den Formularen)
    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Option Explicit
    2. Private Sub Button_InventareingabeStarten_Click()
    3. 'Inventar_Eingabe_Maske aufrufen
    4. Inventar_Eingabe_Maske.Show
    5. End Sub
    6. Private Sub Button_ZubehöreingabeStarten_Click()
    7. 'Zubehör_Maske starten
    8. Zubehör_Maske.Show
    9. End Sub
    10. Private Sub Button_WartungsDurchsichtseingabeStarten_Click()
    11. 'WartungsDurchsichts_Maske aufrufen
    12. WartungsDurchsichts_Maske.Show
    13. End Sub
    14. Private Sub Button_ReparatureingabeStarten_Click()
    15. 'Reparatur_Maske aufrufen
    16. Reparatur_Maske.Show
    17. End Sub
    18. Private Sub Button_AussonderungseingabeStarten_Click()
    19. 'Aussonderungs_Maske aufrufen
    20. Aussonderungs_Maske.Show
    21. End Sub
    22. Private Sub Button_Schliessen_Click()
    23. 'Start_Maske schliessen
    24. Unload Start_Maske
    25. End Sub




    Das mit dem Call hat nur in einer leeren Maske funktioniert, nicht aber in meiner Maske. Das liegt aber vermutlich daran, weil ich etwas
    falsch gemacht habe.

    Ich hatte gedacht, wenn ich einen Extra Button mache, der die anderen Buttons „aufruft“ dann würde sich das Problem mit der „gefüllten“ TextBox erledigen, aber dem ist leider nicht so.

    Wenn ich den Eingabe Button anklicke, dann kommt wie gewünscht die „neue“ Maske mit den Buttons. Dann klicke ich auf Inventareingabe
    starten und es kommt wie gewünscht die Eingabemaske. Hier wähle ich dann mit dem Button „Kalender starten“ ein Datum aus, welches ich mit Datum übernehmen in die Maske einfüge. Als nächstes klicke ich auf Eingeben (es kommt eine MsgBox mit Eingabe erfolgreich) und dann auf Schließen. Die Eingaben sind übernommen und ich wähle die nächste Maske aus. Hier ist die TextBox rechts neben dem
    Button „Kalender starten“ dann mit dem vorherigen Datum belegt. Wenn ich diese Maske ohne Eingaben über den Button Schließen schließe, und dann wieder öffne ist das Datum weg und die TextBox leer. So wie es eigentlich sein soll.

    Irgendwo steckt da noch der Wurm drin.



    Gewöhn dir am besten an wenn du mit Userformen arbeitest bestimmte Makros die du öfters aufrufen musst in ein Modul als Public zu setzen
    Erspart dir eine große schreib und kopier arbeit



    Werde ich versuchen umzusetzen. Für mich ist nur noch nicht so ganz klar, wie das dann funktioniert.

    In meiner jetzigen Maske rufe ich über 5 Userformen die Kalendermaske auf. Eigentlich wäre das ja genau der richtige Zeitpunkt, den Kalender als Modul zu setzen, oder? Oder ist es ehr Unsinn, die 4 Zeilen womit der Kalender aufgerufen wird in ein Modul zu verpacken. Werde es aber probieren.

    Das sind dir 4 Zeilen:

    Visual Basic-Quellcode

    1. Private Sub Button_KalenderStarten_Click()
    2. 'Kalender_Maske starten
    3. Kalender_Maske.Show
    4. End Sub



    Was ich auch gerne mache wenn ich zb.
    wie bei dir Userform initialize habe, schreibe ich nicht gleich mein Makros rein sondern immer nur eine Messagebox, dann sehe ich sofort ob alles passt


    Schreibst du dann deinen Code immer über die Zeile mit der MsgBox, damit sie bei jeder Probe dann noch aufpoppt? Das ist noch nicht ganz klar.



    Auch wenn ich als Anfänger noch "viel" zu lernen habe, was VB angeht, es macht Spaß und wenn man jem. hat, er einem Sachen erklärt und die dann logisch werden oder man durch die Tipps und probieren erfolge erzielt, ist es noch viel schöner.
    Danke für deine Mühe und Geduld.
    Dateien

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Johanne“ ()

    Hallo @Animal2k,
    da ich auf 2 halbe Stellen sitze konnte ich diese Woche die Vorschläge nicht umsetzen. Aber morgen habe ich bis Mittag nur dafür Zeit.
    Ich habe mir die zusätzliche Eingabemaske nochmal angeguckt, die ich erstellt hatte.
    Da sind nun die weiteren Eingabebuttons und beim ausprobieren fiel folgendes auf:
    1. Wenn ich die erste Eingabemaske (Haupteingabemaske) öffne und einen Datum aus dem Kalender auswähle, passt es noch, aber wenn ich die Haupteingabemaske dann mit dem Schließen Button schließe und eine andere Eingabemaske öffne, dann steht in der TextBox (rechts neben dem Kalender starten Button, das Datum, welches ich gerade ausgewählt habe.
    Aus die Zusätzliche Maske hat mein Problem leider nicht gelöst.

    Statt dessen kommt ein zweites hinzu:
    In der Inventareingabemaske ist ein Dropdown und dann sind locker 20 Punkte hinterlegt, die ausgewählt werden können. Aber mit der zusätzlichen Eingabemaske sind die Vorschläge nicht mehr vorhanden.

    Vielleicht kannst du mir nochmal helfen.

    So ist der zusätzliche Eingabebutton programmiert.
    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Option Explicit
    2. Private Sub Button_InventareingabeStarten_Click()
    3. 'Inventar_Eingabe_Maske aufrufen
    4. Inventar_Eingabe_Maske.Show
    5. End Sub
    6. Private Sub Button_ZubehöreingabeStarten_Click()
    7. 'Zubehör_Maske starten
    8. Zubehör_Maske.Show
    9. End Sub
    10. Private Sub Button_WartungsDurchsichtseingabeStarten_Click()
    11. 'WartungsDurchsichts_Maske aufrufen
    12. WartungsDurchsichts_Maske.Show
    13. End Sub
    14. Private Sub Button_ReparatureingabeStarten_Click()
    15. 'Reparatur_Maske aufrufen
    16. Reparatur_Maske.Show
    17. End Sub
    18. Private Sub Button_AussonderungseingabeStarten_Click()
    19. 'Aussonderungs_Maske aufrufen
    20. Aussonderungs_Maske.Show
    21. End Sub
    22. Private Sub Button_Schliessen_Click()
    23. 'Start_Maske schliessen
    24. Unload Start_Maske
    25. End Sub


    ich danke vorab für die Hilfe.
    Ja, da hast du mich richtig verstanden.

    Der zusätzliche Eingabebutton greift dann auf diese Inventareingabemaske zurück:
    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Private Const COMMANDBAR_NAME As String = "MyCommandBar"
    2. Private Sub TextBox_Bezeichnung_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    3. If Button = 2 Then Call CommandBars(COMMANDBAR_NAME).ShowPopup
    4. End Sub
    5. Private Sub UserForm_Initialize()
    6. Call CreateCommandBar
    7. End Sub
    8. Private Sub UserForm_Terminate()
    9. Call DeleteCommandBar
    10. End Sub
    11. Private Sub CreateCommandBar()
    12. Dim objCommandBar As CommandBar
    13. Dim objCommandBarButton As CommandBarButton
    14. Call DeleteCommandBar
    15. Set objCommandBar = CommandBars.Add(Name:=COMMANDBAR_NAME, Position:=msoBarPopup, Temporary:=True)
    16. Set objCommandBarButton = objCommandBar.Controls.Add(Type:=msoControlButton)
    17. With objCommandBarButton
    18. .Caption = "&Einfügen"
    19. .FaceId = 22
    20. .OnAction = "PasteText"
    21. .Style = msoButtonIconAndCaption
    22. End With
    23. End Sub
    24. Private Sub DeleteCommandBar()
    25. Dim objCommandBar As CommandBar
    26. For Each objCommandBar In CommandBars
    27. If objCommandBar.Name = COMMANDBAR_NAME Then Call objCommandBar.Delete
    28. Next
    29. End Sub
    30. Private Sub Inventar_Eingabe_Maske_Initialize()
    31. 'Inventarnummer
    32. TextBox_Inventarnummer.Text = ""
    33. 'Bezeichnung
    34. TextBox_Bezeichnung.Text = ""
    35. 'BezeichnungZusatz
    36. TextBox_BezeichnungZusatz.Text = ""
    37. 'Invertarrubrik
    38. ComboBox_Inventarrubrik = ""
    39. With ComboBox_Inventarrubrik
    40. .AddItem "Bedampfungsanlage"
    41. .AddItem "Brutschränke/Brutgeräte"
    42. .AddItem "Bunsenbrenner"
    43. .AddItem "Büroeinrichtung"
    44. .AddItem "Bürotechnik"
    45. .AddItem "Cycler/PCR-Systeme"
    46. .AddItem "Datenverarbeitung"
    47. .AddItem "Dosierkleingeräte"
    48. .AddItem "Druckminderer"
    49. .AddItem "Durchflusszytometer"
    50. .AddItem "Entsorgung"
    51. .AddItem "Erste-Hilfe"
    52. .AddItem "Fahrzeuge"
    53. .AddItem "Filtrationsgeräte"
    54. .AddItem "Fischhälterung"
    55. .AddItem "Folienschweißgeräte"
    56. .AddItem "Fotografiegeräte+Zubehör"
    57. .AddItem "Gelauswertesystem"
    58. .AddItem "Gelgeräte"
    59. .AddItem "Histologie"
    60. .AddItem "Küchengeräte"
    61. .AddItem "Küchenzeile"
    62. .AddItem "Laborhandgeräte"
    63. .AddItem "Labormöbel"
    64. .AddItem "Laborreinigungsgeräte"
    65. .AddItem "Lagerregale"
    66. .AddItem "Leitern"
    67. .AddItem "Messgeräte Labor"
    68. .AddItem "Messgeräte allgemein"
    69. .AddItem "Mikroskope"
    70. .AddItem "Photometer/ELISA-Reader"
    71. .AddItem "Pipetten"
    72. .AddItem "Pipettierhilfen"
    73. .AddItem "Pipettierroboter"
    74. .AddItem "Präsentationsgegenstände"
    75. .AddItem "Reinig.-u. Desinfektionsautomat"
    76. .AddItem "Reinstwasseranlage/Ionenaust."
    77. .AddItem "Rührgeräte"
    78. .AddItem "Schüttelgeräte"
    79. .AddItem "Separator"
    80. .AddItem "Sequenzierungssysteme"
    81. .AddItem "Sicherheitswerkbänke"
    82. .AddItem "Sonstiges"
    83. .AddItem "Sterilisator/Autoklav"
    84. .AddItem "Strahlenschutz"
    85. .AddItem "Stromversorgungsgeräte"
    86. .AddItem "Telekommunikation"
    87. .AddItem "Thermomixer+Wechselblöcke"
    88. .AddItem "Tiefkühlmöbel+Zubehör"
    89. .AddItem "Tierhaltung"
    90. .AddItem "Transportgeräte"
    91. .AddItem "Ultraschallgeräte"
    92. .AddItem "Vakuumpumpen/Kompressor"
    93. .AddItem "Wasserbad/Thermostate"
    94. .AddItem "Weidezaunanlage"
    95. .AddItem "Werkstattausstattung"
    96. .AddItem "Wohnmöbel"
    97. .AddItem "Wäscherei"
    98. .AddItem "Zellaufschlussgeräte"
    99. .AddItem "Zentrifugen+Rotore"
    100. .AddItem "allg. Reinigungsgeräte"
    101. .AddItem "sonst. Heiz-, Wärme-, Kältegeräte"
    102. End With
    103. 'Auftragsnummer
    104. TextBox_Auftragsnummer.Text = ""
    105. 'KostenBrutto
    106. TextBox_KostenBrutto.Text = ""
    107. 'Lieferdatum
    108. Inventar_Eingabe_Maske.TextBox_Lieferdatum.Text = ""
    109. 'Seriennummer
    110. TextBox_Seriennummer.Text = ""
    111. 'Bundnummer / Inventarnummer ALT
    112. TextBox_Bundnummer.Text = ""
    113. 'Hersteller
    114. TextBox_Hersteller.Text = ""
    115. 'Lieferant
    116. TextBox_Lieferant.Text = ""
    117. 'Rechnungsnummer
    118. TextBox_Rechnungsnummer.Text = ""
    119. 'Bemerkung
    120. TextBox_Bemerkung.Text = ""
    121. 'Verwaltungskontenrahmen
    122. TextBox_Verwaltungskontenrahmen.Text = ""
    123. 'Organisationseinheit
    124. TextBox_Organisationseinheit.Text = ""
    125. 'Nutzer
    126. TextBox_Nutzer.Text = ""
    127. 'Standort
    128. TextBox_Standort.Text = ""
    129. 'GebäudeNr
    130. TextBox_GebäudeNr.Text = ""
    131. 'Etage
    132. TextBox_Etage.Text = ""
    133. 'RaumNr
    134. TextBox_RaumNr.Text = ""
    135. End Sub
    136. Private Sub Button_Schließen_Click()
    137. 'Markierung löschen
    138. Worksheets("Inventar").UsedRange.Interior.Color = RGB(255, 255, 255)
    139. 'Eingabefenster schließen
    140. Unload Inventar_Eingabe_Maske
    141. End Sub
    142. Sub Button_Suchen_Click()
    143. 'Eingaben in der TextBox_Inventarnummer finden
    144. Dim c As Range, ws As Worksheet
    145. Set ws = Worksheets("Inventar")
    146. ws.UsedRange.Interior.Color = RGB(255, 255, 255)
    147. Set c = ws.Range("A:A").Find(TextBox_Inventarnummer.Text, LookIn:=xlValues, LookAt:=xlWhole)
    148. If c Is Nothing Then
    149. MsgBox "nicht Vergeben"
    150. Else
    151. MsgBox "Wert " & TextBox_Inventarnummer.Text & " gefunden in Zelle " & c.Address
    152. c.Interior.Color = RGB(255, 255, 0)
    153. ws.Activate
    154. c.Select
    155. End If
    156. End Sub
    157. Private Sub Button_Eingabe_Click()
    158. 'Eingaben der Schaltfläche in die Arbeitsmappe übernehmen
    159. Dim last As Long
    160. last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    161. 'Inventarnummer
    162. Cells(last, 1).Value = TextBox_Inventarnummer
    163. 'Bezeichnung
    164. Cells(last, 2).Value = TextBox_Bezeichnung
    165. 'BezeichnungZusatz
    166. Cells(last, 3).Value = TextBox_BezeichnungZusatz
    167. 'Invertarrubrik
    168. Cells(last, 4).Value = ComboBox_Inventarrubrik
    169. 'Auftragsnummer
    170. Cells(last, 5).Value = TextBox_Auftragsnummer
    171. 'KostenBrutto
    172. Cells(last, 6).Value = TextBox_KostenBrutto
    173. 'Lieferdatum
    174. Cells(last, 7).Value = TextBox_Lieferdatum
    175. 'Seriennummer
    176. Cells(last, 8).Value = TextBox_Seriennummer
    177. 'Bundnummer / Inventarnummer ALT
    178. Cells(last, 9).Value = TextBox_Bundnummer
    179. 'Hersteller
    180. Cells(last, 10).Value = TextBox_Hersteller
    181. 'Lieferant
    182. Cells(last, 11).Value = TextBox_Lieferant
    183. 'Rechnungsnummer
    184. Cells(last, 12).Value = TextBox_Rechnungsnummer
    185. 'Bemerkung
    186. Cells(last, 13).Value = TextBox_Bemerkung
    187. 'Verwaltungskontenrahmen
    188. Cells(last, 14).Value = TextBox_Verwaltungskontenrahmen
    189. 'Organisationseinheit
    190. Cells(last, 15).Value = TextBox_Organisationseinheit
    191. 'Nutzer
    192. Cells(last, 16).Value = TextBox_Nutzer
    193. 'Standort
    194. Cells(last, 17).Value = TextBox_Standort
    195. 'GebäudeNr
    196. Cells(last, 18).Value = TextBox_GebäudeNr
    197. 'Etage
    198. Cells(last, 19).Value = TextBox_Etage
    199. 'RaumNr
    200. Cells(last, 20).Value = TextBox_RaumNr
    201. MsgBox "Eingabe Erfolgreich"
    202. End Sub
    203. Private Sub Button_KalenderStarten_Click()
    204. 'Kalender_Maske starten
    205. Kalender_Maske.Show
    206. End Sub
    207. Private Sub TextBox_Inventarnummer_Enter()
    208. 'aktivierte Zelle gelb färben
    209. TextBox_Inventarnummer.BackColor = vbYellow
    210. End Sub
    211. Private Sub TextBox_Inventarnummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    212. 'deaktivierte Zelle weiß färben
    213. TextBox_Inventarnummer.BackColor = vbWhite
    214. End Sub
    215. Private Sub TextBox_Bezeichnung_Enter()
    216. 'aktivierte Zelle gelb färben
    217. TextBox_Bezeichnung.BackColor = vbYellow
    218. End Sub
    219. Private Sub TextBox_Bezeichnung_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    220. 'deaktivierte Zelle weiß färben
    221. TextBox_Bezeichnung.BackColor = vbWhite
    222. End Sub
    223. Private Sub TextBox_BezeichnungZusatz_Enter()
    224. 'aktivierte Zelle gelb färben
    225. TextBox_BezeichnungZusatz.BackColor = vbYellow
    226. End Sub
    227. Private Sub TextBox_BezeichnungZusatz_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    228. 'deaktivierte Zelle weiß färben
    229. TextBox_BezeichnungZusatz.BackColor = vbWhite
    230. End Sub
    231. Private Sub ComboBox_Inventarrubrik_Enter()
    232. 'aktivierte Zelle gelb färben
    233. ComboBox_Inventarrubrik.BackColor = vbYellow
    234. End Sub
    235. Private Sub ComboBox_Inventarrubrik_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    236. 'deaktivierte Zelle weiß färben
    237. ComboBox_Inventarrubrik.BackColor = vbWhite
    238. End Sub
    239. Private Sub TextBox_Auftragsnummer_Enter()
    240. 'aktivierte Zelle gelb färben
    241. TextBox_Auftragsnummer.BackColor = vbYellow
    242. End Sub
    243. Private Sub TextBox_Auftragsnummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    244. 'deaktivierte Zelle weiß färben
    245. TextBox_Auftragsnummer.BackColor = vbWhite
    246. End Sub
    247. Private Sub TextBox_KostenBrutto_Enter()
    248. 'aktivierte Zelle gelb färben
    249. TextBox_KostenBrutto.BackColor = vbYellow
    250. End Sub
    251. Private Sub TextBox_KostenBrutto_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    252. 'deaktivierte Zelle weiß färben
    253. TextBox_KostenBrutto.BackColor = vbWhite
    254. End Sub
    255. Private Sub TextBox_Lieferdatum_Enter()
    256. 'TextBox_Lieferdatum leeren
    257. TextBox_Lieferdatum.Value = ""
    258. End Sub
    259. Private Sub TextBox_Lieferdatum_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    260. 'TextBox_Lieferdatum leeren
    261. TextBox_Lieferdatum.Value = ""
    262. End Sub
    263. Private Sub TextBox_Seriennummer_Enter()
    264. 'aktivierte Zelle gelb färben
    265. TextBox_Seriennummer.BackColor = vbYellow
    266. End Sub
    267. Private Sub TextBox_Seriennummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    268. 'deaktivierte Zelle weiß färben
    269. TextBox_Seriennummer.BackColor = vbWhite
    270. End Sub
    271. Private Sub TextBox_Bundnummer_Enter()
    272. 'aktivierte Zelle gelb färben
    273. TextBox_Bundnummer.BackColor = vbYellow
    274. End Sub
    275. Private Sub TextBox_Bundnummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    276. 'deaktivierte Zelle weiß färben
    277. TextBox_Bundnummer.BackColor = vbWhite
    278. End Sub
    279. Private Sub TextBox_Hersteller_Enter()
    280. 'aktivierte Zelle gelb färben
    281. TextBox_Hersteller.BackColor = vbYellow
    282. End Sub
    283. Private Sub TextBox_Hersteller_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    284. 'deaktivierte Zelle weiß färben
    285. TextBox_Hersteller.BackColor = vbWhite
    286. End Sub
    287. Private Sub TextBox_Lieferant_Enter()
    288. 'aktivierte Zelle gelb färben
    289. TextBox_Lieferant.BackColor = vbYellow
    290. End Sub
    291. Private Sub TextBox_Lieferant_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    292. 'deaktivierte Zelle weiß färben
    293. TextBox_Lieferant.BackColor = vbWhite
    294. End Sub
    295. Private Sub TextBox_Rechnungsnummer_Enter()
    296. 'aktivierte Zelle gelb färben
    297. TextBox_Rechnungsnummer.BackColor = vbYellow
    298. End Sub
    299. Private Sub TextBox_Rechnungsnummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    300. 'deaktivierte Zelle weiß färben
    301. TextBox_Rechnungsnummer.BackColor = vbWhite
    302. End Sub
    303. Private Sub TextBox_Bemerkung_Enter()
    304. 'aktivierte Zelle gelb färben
    305. TextBox_Bemerkung.BackColor = vbYellow
    306. End Sub
    307. Private Sub TextBox_Bemerkung_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    308. 'deaktivierte Zelle weiß färben
    309. TextBox_Bemerkung.BackColor = vbWhite
    310. End Sub
    311. Private Sub TextBox_Verwaltungskontenrahmen_Enter()
    312. 'aktivierte Zelle gelb färben
    313. TextBox_Verwaltungskontenrahmen.BackColor = vbYellow
    314. End Sub
    315. Private Sub TextBox_Verwaltungskontenrahmen_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    316. 'deaktivierte Zelle weiß färben
    317. TextBox_Verwaltungskontenrahmen.BackColor = vbWhite
    318. End Sub
    319. Private Sub TextBox_Organisationseinheit_Enter()
    320. 'aktivierte Zelle gelb färben
    321. TextBox_Organisationseinheit.BackColor = vbYellow
    322. End Sub
    323. Private Sub TextBox_Organisationseinheit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    324. 'deaktivierte Zelle weiß färben
    325. TextBox_Organisationseinheit.BackColor = vbWhite
    326. End Sub
    327. Private Sub TextBox_Nutzer_Enter()
    328. 'aktivierte Zelle gelb färben
    329. TextBox_Nutzer.BackColor = vbYellow
    330. End Sub
    331. Private Sub TextBox_Nutzer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    332. 'deaktivierte Zelle weiß färben
    333. TextBox_Nutzer.BackColor = vbWhite
    334. End Sub
    335. Private Sub TextBox_Standort_Enter()
    336. 'aktivierte Zelle gelb färben
    337. TextBox_Standort.BackColor = vbYellow
    338. End Sub
    339. Private Sub TextBox_Standort_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    340. 'deaktivierte Zelle weiß färben
    341. TextBox_Standort.BackColor = vbWhite
    342. End Sub
    343. Private Sub TextBox_GebäudeNr_Enter()
    344. 'aktivierte Zelle gelb färben
    345. TextBox_GebäudeNr.BackColor = vbYellow
    346. End Sub
    347. Private Sub TextBox_GebäudeNr_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    348. 'deaktivierte Zelle weiß färben
    349. TextBox_GebäudeNr.BackColor = vbWhite
    350. End Sub
    351. Private Sub TextBox_Etage_Enter()
    352. 'aktivierte Zelle gelb färben
    353. TextBox_Etage.BackColor = vbYellow
    354. End Sub
    355. Private Sub TextBox_Etage_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    356. 'deaktivierte Zelle weiß färben
    357. TextBox_Etage.BackColor = vbWhite
    358. End Sub
    359. Private Sub TextBox_RaumNr_Enter()
    360. 'aktivierte Zelle gelb färben
    361. TextBox_RaumNr.BackColor = vbYellow
    362. End Sub
    363. Private Sub TextBox_RaumNr_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    364. 'deaktivierte Zelle weiß färben
    365. TextBox_RaumNr.BackColor = vbWhite
    366. End Sub


    Ab Zeile 45/46 beginnt der Text der Dropdown Box, der Text ist hier ersichtlich, aber wenn ich die Dropdownbox öffne, dann ist der Text nicht da.
    Ich habe da bestimmt einen Fehler drin.
    Wenn die Combobox in einer anderen "Form" ist musst du natürlich wieder mit der Initialize arbeiten.
    Sprich;
    Wenn die Form geladen wird wird auch deine Combobox befüllt

    Ich schätze mal die Form wo diese Combobox ist, ist nicht deine Hauptform, ergo hat sie noch keine Zuweisungen.

    Wenn du eine Form hast die später erst(bzw mit einem Button) geladen wird, musst du diese auch mit der Initialise befüllen
    hey,
    konnte diese Woche da nicht weiter machen, daher melde ich mich erst jetzt.

    Woran erkenne ich, welches meine Hauptform ist?
    - ich habe insgesamt 7 Formulare (mit der Start_Maske kann ich die anderen Button aufrufen oder wenn ich auf die Registerkarte Eingaben gehe, damit kann ich meine Eingabe Button auch aufrufen)

    Wie fülle ich meine Form mit INitialise? Bzw. ist es wichtig, ob sie
    Inventar_Eingabe_Maske_Initialize() oder Userform_Initialize() heißt?
    Deine Hauptform ist genau die die mit dem Button auf der Excel Seite geöffnet wird, wenn du jetzt auf deiner "Hauptform" noch einen Button hast um eine andere Form aufzurufen, z.b. die wo die Combobox ist muss der Code für das befüllen genau in diese Form wo die Combobox ist.


    Also die Form auf der die Combobox ist benötigt folgenden Code

    VB.NET-Quellcode

    1. Private Sub UserForm_Initialize()
    2. ComboBox_Inventarrubrik = ""
    3. With ComboBox_Inventarrubrik
    4. .AddItem "Bedampfungsanlage"
    5. .AddItem "Brutschränke/Brutgeräte"
    6. .AddItem "Bunsenbrenner"
    7. .AddItem "Büroeinrichtung"
    8. .AddItem "Bürotechnik"
    9. .AddItem "Cycler/PCR-Systeme"
    10. .AddItem "Datenverarbeitung"
    11. .AddItem "Dosierkleingeräte"
    12. .AddItem "Druckminderer"
    13. .AddItem "Durchflusszytometer"
    14. .AddItem "Entsorgung"
    15. .AddItem "Erste-Hilfe"
    16. .AddItem "Fahrzeuge"
    17. .AddItem "Filtrationsgeräte"
    18. .AddItem "Fischhälterung"
    19. .AddItem "Folienschweißgeräte"
    20. .AddItem "Fotografiegeräte+Zubehör"
    21. .AddItem "Gelauswertesystem"
    22. .AddItem "Gelgeräte"
    23. .AddItem "Histologie"
    24. .AddItem "Küchengeräte"
    25. .AddItem "Küchenzeile"
    26. .AddItem "Laborhandgeräte"
    27. .AddItem "Labormöbel"
    28. .AddItem "Laborreinigungsgeräte"
    29. .AddItem "Lagerregale"
    30. .AddItem "Leitern"
    31. .AddItem "Messgeräte Labor"
    32. .AddItem "Messgeräte allgemein"
    33. .AddItem "Mikroskope"
    34. .AddItem "Photometer/ELISA-Reader"
    35. .AddItem "Pipetten"
    36. .AddItem "Pipettierhilfen"
    37. .AddItem "Pipettierroboter"
    38. .AddItem "Präsentationsgegenstände"
    39. .AddItem "Reinig.-u. Desinfektionsautomat"
    40. .AddItem "Reinstwasseranlage/Ionenaust."
    41. .AddItem "Rührgeräte"
    42. .AddItem "Schüttelgeräte"
    43. .AddItem "Separator"
    44. .AddItem "Sequenzierungssysteme"
    45. .AddItem "Sicherheitswerkbänke"
    46. .AddItem "Sonstiges"
    47. .AddItem "Sterilisator/Autoklav"
    48. .AddItem "Strahlenschutz"
    49. .AddItem "Stromversorgungsgeräte"
    50. .AddItem "Telekommunikation"
    51. .AddItem "Thermomixer+Wechselblöcke"
    52. .AddItem "Tiefkühlmöbel+Zubehör"
    53. .AddItem "Tierhaltung"
    54. .AddItem "Transportgeräte"
    55. .AddItem "Ultraschallgeräte"
    56. .AddItem "Vakuumpumpen/Kompressor"
    57. .AddItem "Wasserbad/Thermostate"
    58. .AddItem "Weidezaunanlage"
    59. .AddItem "Werkstattausstattung"
    60. .AddItem "Wohnmöbel"
    61. .AddItem "Wäscherei"
    62. .AddItem "Zellaufschlussgeräte"
    63. .AddItem "Zentrifugen+Rotore"
    64. .AddItem "allg. Reinigungsgeräte"
    65. .AddItem "sonst. Heiz-, Wärme-, Kältegeräte"
    66. End With
    67. End Sub
    Danke an @petaod und @Animal2k
    Ich habe es gemäß euren Vorschlägen geändert und siehe da,.....die Liste ist wieder da. (Die Combobox funktioniert wieder.)

    Aber das eigentliche Problem, dass die TextBox mit Start leer sein soll, ist leider noch offen.
    Mal sehen, wie sich das beheben lässt, ich vermute, dass es auch eine Kleinigkeit sein wird.
    Hallo,

    mein Problem ist leider noch offen.
    Im Anhang findet ihr die Eingabemaske.

    Ich habe es erneut probiert und nicht hinbekommen. Ich starte die Inventareingabemaske, gebe meine Daten ein und sage dann: Speichern und schließen. Die Maske wird auch gespeichert und geschlossen. Wenn ich dann aber z.B. die Zubehörmaske aufrufe, dann ist die TextBox neben dem Button Kalender starten nicht leer, aber genau das sollte sie sein.
    Ich würde mich freuen, wenn sich das jem anschaut und vielleicht auch eine Idee hat, wie man / ich das Problem beheben kann.

    Hier kommen alle Codes:

    Inventareingabemaske
    Spoiler anzeigen

    Quellcode

    1. Option Explicit
    2. Private Sub UserForm_Initialize()
    3. 'Standort 1
    4. ComboBox_Standort1 = "Dies ist ein Pflcihtfeld!!"
    5. With ComboBox_Standort1
    6. .AddItem "Riems"
    7. .AddItem "Jena"
    8. .AddItem "Niedersachsen"
    9. End With
    10. 'Bezeichnung
    11. TextBox_Bezeichnung.Text = ""
    12. 'BezeichnungZusatz
    13. TextBox_BezeichnungZusatz.Text = ""
    14. 'Invertarrubrik
    15. ComboBox_Inventarrubrik = ""
    16. With ComboBox_Inventarrubrik
    17. .AddItem "Bedampfungsanlage"
    18. .AddItem "Brutschränke/Brutgeräte"
    19. .AddItem "Bunsenbrenner"
    20. .AddItem "Büroeinrichtung"
    21. .AddItem "Bürotechnik"
    22. .AddItem "Cycler/PCR-Systeme"
    23. .AddItem "Datenverarbeitung"
    24. .AddItem "Dosierkleingeräte"
    25. .AddItem "Druckminderer"
    26. .AddItem "Durchflusszytometer"
    27. .AddItem "Entsorgung"
    28. .AddItem "Erste-Hilfe"
    29. .AddItem "Fahrzeuge"
    30. .AddItem "Filtrationsgeräte"
    31. .AddItem "Fischhälterung"
    32. .AddItem "Folienschweißgeräte"
    33. .AddItem "Fotografiegeräte+Zubehör"
    34. .AddItem "Gelauswertesystem"
    35. .AddItem "Gelgeräte"
    36. .AddItem "Histologie"
    37. .AddItem "Küchengeräte"
    38. .AddItem "Küchenzeile"
    39. .AddItem "Laborhandgeräte"
    40. .AddItem "Labormöbel"
    41. .AddItem "Laborreinigungsgeräte"
    42. .AddItem "Lagerregale"
    43. .AddItem "Leitern"
    44. .AddItem "Messgeräte Labor"
    45. .AddItem "Messgeräte allgemein"
    46. .AddItem "Mikroskope"
    47. .AddItem "Photometer/ELISA-Reader"
    48. .AddItem "Pipetten"
    49. .AddItem "Pipettierhilfen"
    50. .AddItem "Pipettierroboter"
    51. .AddItem "Präsentationsgegenstände"
    52. .AddItem "Reinig.-u. Desinfektionsautomat"
    53. .AddItem "Reinstwasseranlage/Ionenaust."
    54. .AddItem "Rührgeräte"
    55. .AddItem "Schüttelgeräte"
    56. .AddItem "Separator"
    57. .AddItem "Sequenzierungssysteme"
    58. .AddItem "Sicherheitswerkbänke"
    59. .AddItem "Sonstiges"
    60. .AddItem "Sterilisator/Autoklav"
    61. .AddItem "Strahlenschutz"
    62. .AddItem "Stromversorgungsgeräte"
    63. .AddItem "Telekommunikation"
    64. .AddItem "Thermomixer+Wechselblöcke"
    65. .AddItem "Tiefkühlmöbel+Zubehör"
    66. .AddItem "Tierhaltung"
    67. .AddItem "Transportgeräte"
    68. .AddItem "Ultraschallgeräte"
    69. .AddItem "Vakuumpumpen/Kompressor"
    70. .AddItem "Wasserbad/Thermostate"
    71. .AddItem "Weidezaunanlage"
    72. .AddItem "Werkstattausstattung"
    73. .AddItem "Wohnmöbel"
    74. .AddItem "Wäscherei"
    75. .AddItem "Zellaufschlussgeräte"
    76. .AddItem "Zentrifugen+Rotore"
    77. .AddItem "allg. Reinigungsgeräte"
    78. .AddItem "sonst. Heiz-, Wärme-, Kältegeräte"
    79. End With
    80. 'Auftragsnummer
    81. TextBox_Auftragsnummer.Text = ""
    82. 'KostenBrutto
    83. TextBox_KostenBrutto.Text = ""
    84. 'Lieferdatum
    85. Inventar_Eingabe_Maske.TextBox_Lieferdatum.Text = ""
    86. 'Seriennummer
    87. TextBox_Seriennummer.Text = ""
    88. 'Bundnummer / Inventarnummer ALT
    89. TextBox_Bundnummer.Text = ""
    90. 'Hersteller
    91. TextBox_Hersteller.Text = ""
    92. 'Lieferant
    93. TextBox_Lieferant.Text = ""
    94. 'Rechnungsnummer
    95. TextBox_Rechnungsnummer.Text = ""
    96. 'Bemerkung
    97. TextBox_Bemerkung.Text = ""
    98. 'Verwaltungskontenrahmen
    99. TextBox_Verwaltungskontenrahmen.Text = ""
    100. 'Organisationseinheit
    101. TextBox_Organisationseinheit.Text = ""
    102. 'Nutzer
    103. TextBox_Nutzer.Text = ""
    104. 'Standort 2
    105. TextBox_Standort2 = ""
    106. 'GebäudeNr
    107. TextBox_GebäudeNr.Text = ""
    108. 'Etage
    109. TextBox_Etage.Text = ""
    110. 'RaumNr
    111. TextBox_RaumNr.Text = ""
    112. End Sub
    113. Private Sub Button_Eingabe_Click()
    114. ' Ein paar Hilfsvariablen festlegen
    115. Dim StandortWahl As String
    116. Dim Zeile As Long
    117. Dim LetzteInventarnrStandort As Long
    118. Dim AktZeilenwert As String
    119. Dim AktLfdNr As Long
    120. Dim last As Long
    121. last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    122. ' Die Daten in die Liste übernehmen
    123. ' Als erstes einmal die Eingaben in Variablen ablegen. Damit ist es gleich leichter auf diese Werte zurückzugreifen
    124. StandortWahl = ComboBox_Standort1.Text
    125. ' Prüfen, ob überhaupt schon Daten da sind
    126. If Sheets("Inventar ab 2021").Range("A1").Value = "" Then
    127. ' Wenn nicht, dann einfach diesen Eintrag zum ersten machen
    128. Sheets("Inventar ab 2021").Range("A1").Value = Mid(StandortWahl, 1, 1) & "-" & Format(Now, "YY") & "-0001"
    129. ' Sub ist in diesen Fall hier zu ende
    130. Exit Sub
    131. End If
    132. 'letzte Nummer des aktuellen Standortes ermitteln
    133. LetzteInventarnrStandort = 0 ' Variablenwert löschen, sicher ist sicher
    134. For Zeile = 1 To 300000000
    135. AktZeilenwert = Sheets("Inventar ab 2021").Range("A" & Zeile).Value
    136. ' Wenn die aktuelle Zeile leer ist, dann sind alle Datensätze durchlaufen
    137. If AktZeilenwert = "" Then
    138. Exit For
    139. End If
    140. ' Prüfen, ob das erste Zeichen der vorhandenen Inventarnr. dem des ersten Zeichens von dem gewählten Standort entspricht
    141. If Mid(AktZeilenwert, 1, 1) = Mid(StandortWahl, 1, 1) Then
    142. ' Aber erst einmal prüfen, ob das Jahr das heutige Jahr ist
    143. If Mid(AktZeilenwert, 3, 2) = Format(Now, "YY") Then
    144. ' Wenn ja, die Nr. sich merken bzw. prüfen, ob diese größer als die letzte gemerkte ist
    145. AktLfdNr = Mid(AktZeilenwert, 6, 4)
    146. If AktLfdNr > LetzteInventarnrStandort Then
    147. LetzteInventarnrStandort = AktLfdNr
    148. End If
    149. End If
    150. End If
    151. Next Zeile
    152. ' Wenn für diesen Standort noch nichts vorhanden ist, dann bei 1 anfangen
    153. ' Da aber die Variable in der nächsten Zeile eh automatisch um 1 erhöht wird, kann hier ruhig LetzteInventarnrStandort = 0 sein
    154. ' jetzt die Daten eintragen
    155. 'Standort 1 auswählen
    156. Sheets("Inventar ab 2021").Range("A" & Zeile).Value = Mid(StandortWahl, 1, 1) & "-" & Format(Now, "YY") & "-" & Format(LetzteInventarnrStandort + 1, "0000")
    157. 'Inventarnummer
    158. 'Cells(last, 1).Value = ComboBox_Standort1
    159. 'Bezeichnung
    160. Cells(last, 2).Value = TextBox_Bezeichnung
    161. 'BezeichnungZusatz
    162. Cells(last, 3).Value = TextBox_BezeichnungZusatz
    163. 'Invertarrubrik
    164. Cells(last, 4).Value = ComboBox_Inventarrubrik
    165. 'Auftragsnummer
    166. Cells(last, 5).Value = TextBox_Auftragsnummer
    167. 'KostenBrutto
    168. Cells(last, 6).Value = TextBox_KostenBrutto
    169. 'Lieferdatum
    170. Cells(last, 7).Value = Inventar_Eingabe_Maske.TextBox_Lieferdatum.Text
    171. 'Seriennummer
    172. Cells(last, 8).Value = TextBox_Seriennummer
    173. 'Bundnummer / Inventarnummer ALT
    174. Cells(last, 9).Value = TextBox_Bundnummer
    175. 'Hersteller
    176. Cells(last, 10).Value = TextBox_Hersteller
    177. 'Lieferant
    178. Cells(last, 11).Value = TextBox_Lieferant
    179. 'Rechnungsnummer
    180. Cells(last, 12).Value = TextBox_Rechnungsnummer
    181. 'Bemerkung
    182. Cells(last, 13).Value = TextBox_Bemerkung
    183. 'Verwaltungskontenrahmen
    184. Cells(last, 14).Value = TextBox_Verwaltungskontenrahmen
    185. 'Organisationseinheit
    186. Cells(last, 15).Value = TextBox_Organisationseinheit
    187. 'Nutzer
    188. Cells(last, 16).Value = TextBox_Nutzer
    189. 'Standort 2
    190. Cells(last, 17).Value = TextBox_Standort2
    191. 'GebäudeNr
    192. Cells(last, 18).Value = TextBox_GebäudeNr
    193. 'Etage
    194. Cells(last, 19).Value = TextBox_Etage
    195. 'RaumNr
    196. Cells(last, 20).Value = TextBox_RaumNr
    197. MsgBox "Ihre Eingabe war Erfolgreich"
    198. 'Daten speichern
    199. ThisWorkbook.Save
    200. 'Blatt leeren
    201. 'Standort 1
    202. ComboBox_Standort1 = ""
    203. 'Bezeichnung
    204. TextBox_Bezeichnung.Text = ""
    205. 'BezeichnungZusatz
    206. TextBox_BezeichnungZusatz.Text = ""
    207. 'Invertarrubrik
    208. ComboBox_Inventarrubrik = ""
    209. 'Auftragsnummer
    210. TextBox_Auftragsnummer.Text = ""
    211. 'KostenBrutto
    212. TextBox_KostenBrutto.Text = ""
    213. 'Lieferdatum
    214. Inventar_Eingabe_Maske.TextBox_Lieferdatum.Text = ""
    215. 'Seriennummer
    216. TextBox_Seriennummer.Text = ""
    217. 'Bundnummer / Inventarnummer ALT
    218. TextBox_Bundnummer.Text = ""
    219. 'Hersteller
    220. TextBox_Hersteller.Text = ""
    221. 'Lieferant
    222. TextBox_Lieferant.Text = ""
    223. 'Rechnungsnummer
    224. TextBox_Rechnungsnummer.Text = ""
    225. 'Bemerkung
    226. TextBox_Bemerkung.Text = ""
    227. 'Verwaltungskontenrahmen
    228. TextBox_Verwaltungskontenrahmen.Text = ""
    229. 'Organisationseinheit
    230. TextBox_Organisationseinheit.Text = ""
    231. 'Nutzer
    232. TextBox_Nutzer.Text = ""
    233. 'Standort 2
    234. TextBox_Standort2 = ""
    235. 'GebäudeNr
    236. TextBox_GebäudeNr.Text = ""
    237. 'Etage
    238. TextBox_Etage.Text = ""
    239. 'RaumNr
    240. TextBox_RaumNr.Text = ""
    241. End Sub
    242. Private Sub Button_KalenderStarten_Click()
    243. 'Kalender_Maske starten
    244. Kalender_Maske.Show
    245. End Sub
    246. Private Sub ComboBox_Standort1_Enter()
    247. 'aktivierte Zelle gelb färben
    248. ComboBox_Standort1.BackColor = vbYellow
    249. End Sub
    250. Private Sub ComboBox_Standort1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    251. 'deaktivierte Zelle weiß färben
    252. ComboBox_Standort1.BackColor = vbWhite
    253. End Sub
    254. Private Sub TextBox_Bezeichnung_Enter()
    255. 'aktivierte Zelle gelb färben
    256. TextBox_Bezeichnung.BackColor = vbYellow
    257. End Sub
    258. Private Sub TextBox_Bezeichnung_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    259. 'deaktivierte Zelle weiß färben
    260. TextBox_Bezeichnung.BackColor = vbWhite
    261. End Sub
    262. Private Sub TextBox_BezeichnungZusatz_Enter()
    263. 'aktivierte Zelle gelb färben
    264. TextBox_BezeichnungZusatz.BackColor = vbYellow
    265. End Sub
    266. Private Sub TextBox_BezeichnungZusatz_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    267. 'deaktivierte Zelle weiß färben
    268. TextBox_BezeichnungZusatz.BackColor = vbWhite
    269. End Sub
    270. Private Sub ComboBox_Inventarrubrik_Enter()
    271. 'aktivierte Zelle gelb färben
    272. ComboBox_Inventarrubrik.BackColor = vbYellow
    273. End Sub
    274. Private Sub ComboBox_Inventarrubrik_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    275. 'deaktivierte Zelle weiß färben
    276. ComboBox_Inventarrubrik.BackColor = vbWhite
    277. End Sub
    278. Private Sub TextBox_Auftragsnummer_Enter()
    279. 'aktivierte Zelle gelb färben
    280. TextBox_Auftragsnummer.BackColor = vbYellow
    281. End Sub
    282. Private Sub TextBox_Auftragsnummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    283. 'deaktivierte Zelle weiß färben
    284. TextBox_Auftragsnummer.BackColor = vbWhite
    285. End Sub
    286. Private Sub TextBox_KostenBrutto_Enter()
    287. 'aktivierte Zelle gelb färben
    288. TextBox_KostenBrutto.BackColor = vbYellow
    289. End Sub
    290. Private Sub TextBox_KostenBrutto_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    291. 'deaktivierte Zelle weiß färben
    292. TextBox_KostenBrutto.BackColor = vbWhite
    293. End Sub
    294. Private Sub TextBox_Lieferdatum_Enter()
    295. 'TextBox_Lieferdatum leeren
    296. TextBox_Lieferdatum.Value = ""
    297. End Sub
    298. Private Sub TextBox_Lieferdatum_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    299. 'TextBox_Lieferdatum leeren
    300. TextBox_Lieferdatum.Value = ""
    301. End Sub
    302. Private Sub TextBox_Seriennummer_Enter()
    303. 'aktivierte Zelle gelb färben
    304. TextBox_Seriennummer.BackColor = vbYellow
    305. End Sub
    306. Private Sub TextBox_Seriennummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    307. 'deaktivierte Zelle weiß färben
    308. TextBox_Seriennummer.BackColor = vbWhite
    309. End Sub
    310. Private Sub TextBox_Bundnummer_Enter()
    311. 'aktivierte Zelle gelb färben
    312. TextBox_Bundnummer.BackColor = vbYellow
    313. End Sub
    314. Private Sub TextBox_Bundnummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    315. 'deaktivierte Zelle weiß färben
    316. TextBox_Bundnummer.BackColor = vbWhite
    317. End Sub
    318. Private Sub TextBox_Hersteller_Enter()
    319. 'aktivierte Zelle gelb färben
    320. TextBox_Hersteller.BackColor = vbYellow
    321. End Sub
    322. Private Sub TextBox_Hersteller_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    323. 'deaktivierte Zelle weiß färben
    324. TextBox_Hersteller.BackColor = vbWhite
    325. End Sub
    326. Private Sub TextBox_Lieferant_Enter()
    327. 'aktivierte Zelle gelb färben
    328. TextBox_Lieferant.BackColor = vbYellow
    329. End Sub
    330. Private Sub TextBox_Lieferant_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    331. 'deaktivierte Zelle weiß färben
    332. TextBox_Lieferant.BackColor = vbWhite
    333. End Sub
    334. Private Sub TextBox_Rechnungsnummer_Enter()
    335. 'aktivierte Zelle gelb färben
    336. TextBox_Rechnungsnummer.BackColor = vbYellow
    337. End Sub
    338. Private Sub TextBox_Rechnungsnummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    339. 'deaktivierte Zelle weiß färben
    340. TextBox_Rechnungsnummer.BackColor = vbWhite
    341. End Sub
    342. Private Sub TextBox_Bemerkung_Enter()
    343. 'aktivierte Zelle gelb färben
    344. TextBox_Bemerkung.BackColor = vbYellow
    345. End Sub
    346. Private Sub TextBox_Bemerkung_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    347. 'deaktivierte Zelle weiß färben
    348. TextBox_Bemerkung.BackColor = vbWhite
    349. End Sub
    350. Private Sub TextBox_Verwaltungskontenrahmen_Enter()
    351. 'aktivierte Zelle gelb färben
    352. TextBox_Verwaltungskontenrahmen.BackColor = vbYellow
    353. End Sub
    354. Private Sub TextBox_Verwaltungskontenrahmen_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    355. 'deaktivierte Zelle weiß färben
    356. TextBox_Verwaltungskontenrahmen.BackColor = vbWhite
    357. End Sub
    358. Private Sub TextBox_Organisationseinheit_Enter()
    359. 'aktivierte Zelle gelb färben
    360. TextBox_Organisationseinheit.BackColor = vbYellow
    361. End Sub
    362. Private Sub TextBox_Organisationseinheit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    363. 'deaktivierte Zelle weiß färben
    364. TextBox_Organisationseinheit.BackColor = vbWhite
    365. End Sub
    366. Private Sub TextBox_Nutzer_Enter()
    367. 'aktivierte Zelle gelb färben
    368. TextBox_Nutzer.BackColor = vbYellow
    369. End Sub
    370. Private Sub TextBox_Nutzer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    371. 'deaktivierte Zelle weiß färben
    372. TextBox_Nutzer.BackColor = vbWhite
    373. End Sub
    374. Private Sub TextBox_GebäudeNr_Enter()
    375. 'aktivierte Zelle gelb färben
    376. TextBox_GebäudeNr.BackColor = vbYellow
    377. End Sub
    378. Private Sub TextBox_GebäudeNr_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    379. 'deaktivierte Zelle weiß färben
    380. TextBox_GebäudeNr.BackColor = vbWhite
    381. End Sub
    382. Private Sub TextBox_Etage_Enter()
    383. 'aktivierte Zelle gelb färben
    384. TextBox_Etage.BackColor = vbYellow
    385. End Sub
    386. Private Sub TextBox_Etage_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    387. 'deaktivierte Zelle weiß färben
    388. TextBox_Etage.BackColor = vbWhite
    389. End Sub
    390. Private Sub TextBox_RaumNr_Enter()
    391. 'aktivierte Zelle gelb färben
    392. TextBox_RaumNr.BackColor = vbYellow
    393. End Sub
    394. Private Sub TextBox_RaumNr_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    395. 'deaktivierte Zelle weiß färben
    396. TextBox_RaumNr.BackColor = vbWhite
    397. End Sub
    398. Private Sub Button_Speichern_u_Schließen_Click()
    399. ' Ein paar Hilfsvariablen festlegen
    400. Dim StandortWahl As String
    401. Dim Zeile As Long
    402. Dim LetzteInventarnrStandort As Integer
    403. Dim AktZeilenwert As String
    404. Dim AktLfdNr As Integer
    405. Dim last As Long
    406. last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    407. ' Die Daten in die Liste übernehmen
    408. ' Als erstes einmal die Eingaben in Variablen ablegen.
    409. 'Damit ist es gleich leichter auf diese Werte zurückzugreifen
    410. StandortWahl = ComboBox_Standort1
    411. ' Prüfen, ob überhaupt schon Daten da sind
    412. If Sheets("Inventar ab 2021").Range("A1").Value = "" Then
    413. ' Wenn nicht, dann einfach diesen Eintrag zum ersten machen
    414. Sheets("Inventar ab 2021").Range("A1").Value = Mid(StandortWahl, 1, 1) & "-" & Format(Now, "YY") & "-0001"
    415. ' Sub ist in diesen Fall hier zu ende
    416. Exit Sub
    417. End If
    418. 'letzte Nummer des aktuellen Standortes ermitteln
    419. LetzteInventarnrStandort = 0 ' Variablenwert löschen, sicher ist sicher
    420. For Zeile = 1 To 30000000
    421. AktZeilenwert = Sheets("Inventar ab 2021").Range("A" & Zeile).Value
    422. ' Wenn die aktuelle Zeile leer ist, dann sind alle Datensätze durchlaufen
    423. If AktZeilenwert = "" Then
    424. Exit For
    425. End If
    426. ' Prüfen, ob das erste Zeichen der vorhandenen Inventarnr. dem des ersten Zeichens von dem gewählten Standort entspricht
    427. If Mid(AktZeilenwert, 1, 1) = Mid(StandortWahl, 1, 1) Then
    428. ' Aber erst einmal prüfen, ob das Jahr das heutige Jahr ist
    429. If Mid(AktZeilenwert, 3, 2) = Format(Now, "YY") Then
    430. ' Wenn ja, die Nr. sich merken bzw. prüfen, ob diese größer als die letzte gemerkte ist
    431. AktLfdNr = Mid(AktZeilenwert, 6, 4)
    432. If AktLfdNr > LetzteInventarnrStandort Then
    433. LetzteInventarnrStandort = AktLfdNr
    434. End If
    435. End If
    436. End If
    437. Next Zeile
    438. ' Wenn für diesen Standort noch nichts vorhanden ist, dann bei 1 anfangen
    439. ' Da aber die Variable in der nächsten Zeile eh automatisch um 1 erhöht wird, kann hier ruhig LetzteInventarnrStandort = 0 sein
    440. ' jetzt die Daten eintragen
    441. 'Standort 1 auswählen
    442. Sheets("Inventar ab 2021").Range("A" & Zeile).Value = Mid(StandortWahl, 1, 1) & "-" & Format(Now, "YY") & "-" & Format(LetzteInventarnrStandort + 1, "0000")
    443. 'Inventarnummer
    444. 'Cells(last, 1).Value = ComboBox_Standort1
    445. 'Bezeichnung
    446. Cells(last, 2).Value = TextBox_Bezeichnung
    447. 'BezeichnungZusatz
    448. Cells(last, 3).Value = TextBox_BezeichnungZusatz
    449. 'Invertarrubrik
    450. Cells(last, 4).Value = ComboBox_Inventarrubrik
    451. 'Auftragsnummer
    452. Cells(last, 5).Value = TextBox_Auftragsnummer
    453. 'KostenBrutto
    454. Cells(last, 6).Value = TextBox_KostenBrutto
    455. 'Lieferdatum
    456. Cells(last, 7).Value = Inventar_Eingabe_Maske.TextBox_Lieferdatum.Text
    457. 'Seriennummer
    458. Cells(last, 8).Value = TextBox_Seriennummer
    459. 'Bundnummer / Inventarnummer ALT
    460. Cells(last, 9).Value = TextBox_Bundnummer
    461. 'Hersteller
    462. Cells(last, 10).Value = TextBox_Hersteller
    463. 'Lieferant
    464. Cells(last, 11).Value = TextBox_Lieferant
    465. 'Rechnungsnummer
    466. Cells(last, 12).Value = TextBox_Rechnungsnummer
    467. 'Bemerkung
    468. Cells(last, 13).Value = TextBox_Bemerkung
    469. 'Verwaltungskontenrahmen
    470. Cells(last, 14).Value = TextBox_Verwaltungskontenrahmen
    471. 'Organisationseinheit
    472. Cells(last, 15).Value = TextBox_Organisationseinheit
    473. 'Nutzer
    474. Cells(last, 16).Value = TextBox_Nutzer
    475. 'Standort 2
    476. Cells(last, 17).Value = TextBox_Standort2
    477. 'GebäudeNr
    478. Cells(last, 18).Value = TextBox_GebäudeNr
    479. 'Etage
    480. Cells(last, 19).Value = TextBox_Etage
    481. 'RaumNr
    482. Cells(last, 20).Value = TextBox_RaumNr
    483. MsgBox "Ihre Eingabe war Erfolgreich"
    484. 'Daten speichern
    485. ThisWorkbook.Save
    486. 'Blatt leeren
    487. 'Standort 1
    488. ComboBox_Standort1 = ""
    489. 'Bezeichnung
    490. TextBox_Bezeichnung.Text = ""
    491. 'BezeichnungZusatz
    492. TextBox_BezeichnungZusatz.Text = ""
    493. 'Invertarrubrik
    494. ComboBox_Inventarrubrik = ""
    495. 'Auftragsnummer
    496. TextBox_Auftragsnummer.Text = ""
    497. 'KostenBrutto
    498. TextBox_KostenBrutto.Text = ""
    499. 'Lieferdatum
    500. Inventar_Eingabe_Maske.TextBox_Lieferdatum.Text = ""
    501. 'Seriennummer
    502. TextBox_Seriennummer.Text = ""
    503. 'Bundnummer / Inventarnummer ALT
    504. TextBox_Bundnummer.Text = ""
    505. 'Hersteller
    506. TextBox_Hersteller.Text = ""
    507. 'Lieferant
    508. TextBox_Lieferant.Text = ""
    509. 'Rechnungsnummer
    510. TextBox_Rechnungsnummer.Text = ""
    511. 'Bemerkung
    512. TextBox_Bemerkung.Text = ""
    513. 'Verwaltungskontenrahmen
    514. TextBox_Verwaltungskontenrahmen.Text = ""
    515. 'Organisationseinheit
    516. TextBox_Organisationseinheit.Text = ""
    517. 'Nutzer
    518. TextBox_Nutzer.Text = ""
    519. 'Standort 2
    520. TextBox_Standort2 = ""
    521. 'GebäudeNr
    522. TextBox_GebäudeNr.Text = ""
    523. 'Etage
    524. TextBox_Etage.Text = ""
    525. 'RaumNr
    526. TextBox_RaumNr.Text = ""
    527. 'Maske schließen
    528. Unload Inventar_Eingabe_Maske
    529. End Sub
    530. Private Sub Button_Schließen_Click()
    531. 'Markierung löschen
    532. Worksheets("Inventar ab 2021").UsedRange.Interior.Color = RGB(255, 255, 255)
    533. 'Eingabefenster schließen
    534. Unload Inventar_Eingabe_Maske
    535. 'TextBox_Lieferdatum leeren
    536. TextBox_Lieferdatum.Value = ""
    537. End Sub
    538. Private Sub ComboBox_Standort1_Change()
    539. If ComboBox_Standort1 = "Riems" Then
    540. TextBox_Standort2 = "Riems"
    541. ElseIf ComboBox_Standort1 = "Jena" Then
    542. TextBox_Standort2 = "Jena"
    543. ElseIf ComboBox_Standort1 = "Niedersachsen" Then
    544. TextBox_Standort2 = "Niedersachsen"
    545. End If
    546. End Sub
    547. Private Sub TextBox_Bezeichnung_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    548. If Button = 2 Then TextBox_Bezeichnung.Paste 'right button
    549. End Sub
    550. Private Sub TextBox_BezeichnungZusatz_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    551. If Button = 2 Then TextBox_BezeichnungZusatz.Paste 'right button
    552. End Sub
    553. Private Sub TextBox_Auftragsnummer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    554. If Button = 2 Then TextBox_Auftragsnummer.Paste 'right button
    555. End Sub
    556. Private Sub TextBox_KostenBrutto_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    557. If Button = 2 Then TextBox_KostenBrutto.Paste 'right button
    558. End Sub
    559. Private Sub TextBox_Seriennummer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    560. If Button = 2 Then TextBox_Seriennummer.Paste 'right button
    561. End Sub
    562. Private Sub TextBox_Bundnummer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    563. If Button = 2 Then TextBox_Bundnummer.Paste 'right button
    564. End Sub
    565. Private Sub TextBox_Hersteller_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    566. If Button = 2 Then TextBox_Hersteller.Paste 'right button
    567. End Sub
    568. Private Sub TextBox_Lieferant_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    569. If Button = 2 Then TextBox_Lieferant.Paste 'right button
    570. End Sub
    571. Private Sub TextBox_Rechnungsnummer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    572. If Button = 2 Then TextBox_Rechnungsnummer.Paste 'right button
    573. End Sub
    574. Private Sub TextBox_Bemerkung_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    575. If Button = 2 Then TextBox_Bemerkung.Paste 'right button
    576. End Sub
    577. Private Sub TextBox_Verwaltungskontenrahmen_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    578. If Button = 2 Then TextBox_Verwaltungskontenrahmen.Paste 'right button
    579. End Sub
    580. Private Sub TextBox_Organisationseinheit_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    581. If Button = 2 Then TextBox_Organisationseinheit.Paste 'right button
    582. End Sub
    583. Private Sub TextBox_Nutzer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    584. If Button = 2 Then TextBox_Nutzer.Paste 'right button
    585. End Sub
    586. Private Sub TextBox_GebäudeNr_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    587. If Button = 2 Then TextBox_GebäudeNr.Paste 'right button
    588. End Sub
    589. Private Sub TextBox_Etage_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    590. If Button = 2 Then TextBox_GebäudeNr.Paste 'right button
    591. End Sub
    592. Private Sub TextBox_RaumNr_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    593. If Button = 2 Then TextBox_RaumNr.Paste 'right button
    594. End Sub



    Zubehöreingabemaske
    Spoiler anzeigen

    Quellcode

    1. Option Explicit
    2. Private Sub Zubehör_Maske_Initialize()
    3. Dim last As Long
    4. last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    5. ' Die Daten in die Liste übernehmen
    6. 'Inventarnummer
    7. TextBox_Inventarnummer = "Die ist ein Pflichtfeld"
    8. 'Bezeichnung
    9. TextBox_Bezeichnung = ""
    10. 'BezeichnungZusatz
    11. TextBox_BezeichnungZusatz = ""
    12. 'Inventarnummer ALT
    13. TextBox_InventarnummerALT = ""
    14. 'Hersteller
    15. TextBox_Hersteller = ""
    16. 'Lieferant
    17. TextBox_Lieferant = ""
    18. 'Kaufdatum des Zubehörs
    19. Zubehör_Maske.TextBox_KaufdatumDesZubehörs = ""
    20. 'Kosten des Zubehörs Brutto
    21. TextBox_KostenDesZubehörsBrutto = ""
    22. If CheckBox1.Value Then
    23. CheckBox1 = Cells(22)
    24. End If
    25. End Sub
    26. Private Sub TextBox_Inventarnummer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    27. If Button = 2 Then TextBox_Inventarnummer.Paste 'right button
    28. End Sub
    29. Private Sub TextBox_Bezeichnung_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    30. If Button = 2 Then TextBox_Bezeichnung.Paste 'right button
    31. End Sub
    32. Private Sub TextBox_BezeichnungZusatz_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    33. If Button = 2 Then TextBox_BezeichnungZusatz.Paste 'right button
    34. End Sub
    35. Private Sub TextBox_InventarnummerALT_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    36. If Button = 2 Then TextBox_InventarnummerALT.Paste 'right button
    37. End Sub
    38. Private Sub TextBox_Hersteller_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    39. If Button = 2 Then TextBox_Hersteller.Paste 'right button
    40. End Sub
    41. Private Sub TextBox_Lieferant_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    42. If Button = 2 Then TextBox_Lieferant.Paste 'right button
    43. End Sub
    44. Private Sub TextBox_KostenDesZubehörsBrutto_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    45. If Button = 2 Then TextBox_KostenDesZubehörsBrutto.Paste 'right button
    46. End Sub
    47. Private Sub Button_Eingabe_Click()
    48. 'Eingaben der Schaltfläche in die Arbeitsmappe übernehmen
    49. Dim last As Long
    50. last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    51. 'Inventarnummer
    52. Cells(last, 1).Value = TextBox_Inventarnummer
    53. 'Bezeichnung
    54. Cells(last, 2).Value = TextBox_Bezeichnung
    55. 'BezeichnungZusatz
    56. Cells(last, 3).Value = TextBox_BezeichnungZusatz
    57. 'Inventarnummer ALT
    58. Cells(last, 9).Value = TextBox_InventarnummerALT
    59. 'Hersteller
    60. Cells(last, 10).Value = TextBox_Hersteller
    61. 'Lieferant
    62. Cells(last, 11).Value = TextBox_Lieferant
    63. 'Kaufdatum des Zubehörs
    64. Cells(last, 35).Value = Zubehör_Maske.TextBox_KaufdatumDesZubehörs.Text
    65. 'Kosten des Zubehörs Brutto
    66. Cells(last, 36).Value = TextBox_KostenDesZubehörsBrutto
    67. 'Zubehör
    68. Cells(last, 22).Value = "X"
    69. MsgBox "Ihre Eingabe war erfolgreich"
    70. 'Daten speichern
    71. ThisWorkbook.Save
    72. 'Blatt leeren
    73. 'Inventarnummer
    74. TextBox_Inventarnummer.Text = ""
    75. 'Bezeichnung
    76. TextBox_Bezeichnung.Text = ""
    77. 'BezeichnungZusatz
    78. TextBox_BezeichnungZusatz.Text = ""
    79. 'Inventarnummer ALT
    80. TextBox_InventarnummerALT = ""
    81. 'Hersteller
    82. TextBox_Hersteller = ""
    83. 'Lieferant
    84. TextBox_Lieferant = ""
    85. 'Kaufdatum des Zubehörs
    86. Zubehör_Maske.TextBox_KaufdatumDesZubehörs.Text = ""
    87. 'Kosten des Zubehörs Brutto
    88. TextBox_KostenDesZubehörsBrutto.Text = ""
    89. End Sub
    90. Private Sub Button_Speichern_u_Schließen_Click()
    91. ' Ein paar Hilfsvariablen festlegen
    92. Dim last As Long
    93. last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    94. ' Die Daten in die Liste übernehmen
    95. ' jetzt die Daten eintragen
    96. 'Inventarnummer
    97. Cells(last, 1).Value = TextBox_Inventarnummer
    98. 'Bezeichnung
    99. Cells(last, 2).Value = TextBox_Bezeichnung
    100. 'BezeichnungZusatz
    101. Cells(last, 3).Value = TextBox_BezeichnungZusatz
    102. 'Inventarnummer ALT
    103. Cells(last, 9).Value = TextBox_InventarnummerALT
    104. 'Hersteller
    105. Cells(last, 10).Value = TextBox_Hersteller
    106. 'Lieferant
    107. Cells(last, 11).Value = TextBox_Lieferant
    108. 'Kaufdatum des Zubehörs
    109. Cells(last, 35).Value = Zubehör_Maske.TextBox_KaufdatumDesZubehörs.Text
    110. 'Kosten des Zubehörs Brutto
    111. Cells(last, 36).Value = TextBox_KostenDesZubehörsBrutto
    112. 'Zubehör
    113. Cells(last, 22).Value = "X"
    114. MsgBox "Ihre Eingabe war Erfolgreich"
    115. 'Daten speichern
    116. ThisWorkbook.Save
    117. 'Blatt leeren
    118. 'Inventarnummer
    119. TextBox_Inventarnummer.Text = ""
    120. 'Bezeichnung
    121. TextBox_Bezeichnung.Text = ""
    122. 'BezeichnungZusatz
    123. TextBox_BezeichnungZusatz.Text = ""
    124. 'Inventarnummer ALT
    125. TextBox_InventarnummerALT = ""
    126. 'Hersteller
    127. TextBox_Hersteller = ""
    128. 'Lieferant
    129. TextBox_Lieferant = ""
    130. 'Kaufdatum des Zubehörs
    131. Zubehör_Maske.TextBox_KaufdatumDesZubehörs.Text = ""
    132. 'Kosten des Zubehörs Brutto
    133. TextBox_KostenDesZubehörsBrutto.Text = ""
    134. 'Maske schließen
    135. Unload Zubehör_Maske
    136. End Sub
    137. Private Sub Button_Schließen_Click()
    138. 'Eingabefenster schließen
    139. Unload Zubehör_Maske
    140. 'TextBox_KaufdatumDesZubehörs leeren
    141. TextBox_KaufdatumDesZubehörs.Value = ""
    142. End Sub
    143. Private Sub Button_KalenderStarten_Click()
    144. 'Kalender_Maske starten
    145. Kalender_Maske.Show
    146. End Sub
    147. Private Sub TextBox_Inventarnummer_Enter()
    148. 'aktivierte Zelle gelb färben
    149. TextBox_Inventarnummer.BackColor = vbYellow
    150. End Sub
    151. Private Sub TextBox_Inventarnummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    152. 'deaktivierte Zelle weiß färben
    153. TextBox_Inventarnummer.BackColor = vbWhite
    154. End Sub
    155. Private Sub TextBox_Bezeichnung_Enter()
    156. 'aktivierte Zelle gelb färben
    157. TextBox_Bezeichnung.BackColor = vbYellow
    158. End Sub
    159. Private Sub TextBox_Bezeichnung_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    160. 'deaktivierte Zelle weiß färben
    161. TextBox_Bezeichnung.BackColor = vbWhite
    162. End Sub
    163. Private Sub TextBox_BezeichnungZusatz_Enter()
    164. 'aktivierte Zelle gelb färben
    165. TextBox_BezeichnungZusatz.BackColor = vbYellow
    166. End Sub
    167. Private Sub TextBox_BezeichnungZusatz_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    168. 'deaktivierte Zelle weiß färben
    169. TextBox_BezeichnungZusatz.BackColor = vbWhite
    170. End Sub
    171. Private Sub TextBox_InventarnummerALT_Enter()
    172. 'aktivierte Zelle gelb färben
    173. TextBox_InventarnummerALT.BackColor = vbYellow
    174. End Sub
    175. Private Sub TextBox_InventarnummerALT_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    176. 'deaktivierte Zelle weiß färben
    177. TextBox_InventarnummerALT.BackColor = vbWhite
    178. End Sub
    179. Private Sub TextBox_Hersteller_Enter()
    180. 'aktivierte Zelle gelb färben
    181. TextBox_Hersteller.BackColor = vbYellow
    182. End Sub
    183. Private Sub TextBox_Hersteller_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    184. 'deaktivierte Zelle weiß färben
    185. TextBox_Hersteller.BackColor = vbWhite
    186. End Sub
    187. Private Sub TextBox_Lieferant_Enter()
    188. 'aktivierte Zelle gelb färben
    189. TextBox_Lieferant.BackColor = vbYellow
    190. End Sub
    191. Private Sub TextBox_Lieferant_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    192. 'deaktivierte Zelle weiß färben
    193. TextBox_Lieferant.BackColor = vbWhite
    194. End Sub
    195. Private Sub TextBox_KostenDesZubehörsBrutto_Enter()
    196. 'aktivierte Zelle gelb färben
    197. TextBox_KostenDesZubehörsBrutto.BackColor = vbYellow
    198. End Sub
    199. Private Sub TextBox_KostenDesZubehörsBrutto_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    200. 'deaktivierte Zelle weiß färben
    201. TextBox_KostenDesZubehörsBrutto.BackColor = vbWhite
    202. End Sub



    Kalendereingabemaske
    Spoiler anzeigen

    Quellcode

    1. 'Die Position der Userform kann vorab festgelegt werden
    2. 'Wahlweise das Ergebnis in die Zwischenablage kopieren
    3. Option Explicit
    4. Option Compare Text
    5. #If VBA7 Then
    6. Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
    7. ByVal dwBytes As LongPtr) As LongPtr
    8. Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    9. Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
    10. Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
    11. ByVal lpString2 As Any) As LongPtr
    12. Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, _
    13. ByVal hMem As LongPtr) As LongPtr
    14. Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
    15. Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    16. Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    17. Private Declare PtrSafe Function SetWindowPos Lib "user32" ( _
    18. ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _
    19. ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
    20. ByVal cy As Long, ByVal wFlags As Long) As Long
    21. Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long)
    22. Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    23. ByVal lpClassName As String, _
    24. ByVal lpWindowName As String) As LongPtr
    25. #If Win64 Then
    26. Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" ( _
    27. ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
    28. Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" ( _
    29. ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    30. #Else
    31. Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" ( _
    32. ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
    33. Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" ( _
    34. ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    35. #End If
    36. Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _
    37. ByVal hWnd As LongPtr, lpRect As RECT) As Long
    38. Private hWnd As LongPtr
    39. Private frmStyle As LongPtr
    40. #Else
    41. Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
    42. ByVal dwBytes As Long) As Long
    43. Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    44. Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    45. Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
    46. ByVal lpString2 As Any) As Long
    47. Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, _
    48. ByVal hMem As Long) As Long
    49. Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
    50. Private Declare Function CloseClipboard Lib "user32" () As Long
    51. Private Declare Function EmptyClipboard Lib "user32" () As Long
    52. Private Declare Function SetWindowPos Lib "user32" ( _
    53. ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
    54. ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
    55. ByVal cy As Long, ByVal wFlags As Long) As Long
    56. Private Declare Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long)
    57. Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    58. ByVal lpClassName As String, _
    59. ByVal lpWindowName As String) As Long
    60. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    61. ByVal lpClassName As String, _
    62. ByVal lpWindowName As String) As Long
    63. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
    64. ByVal hWnd As Long, ByVal nIndex As Long) As Long
    65. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
    66. ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    67. Private Declare Function GetWindowRect Lib "user32" ( _
    68. ByVal hWnd As Long, lpRect As RECT) As Long
    69. Private hWnd As Long
    70. Private frmStyle As Long
    71. #End If
    72. Private Type POINTAPI
    73. X As Long
    74. Y As Long
    75. End Type
    76. Private Type RECT
    77. Left As Long
    78. Top As Long
    79. Right As Long
    80. Bottom As Long
    81. End Type
    82. Const GWL_STYLE = -16
    83. Const WS_CAPTION = &HC00000
    84. Dim iZeile As Long, i As Integer
    85. Dim aktDat As Date
    86. Dim cLabel() As New clsLabel
    87. Dim Ptx As Single, Pty As Single
    88. '#### Bereiche, wo man noch was einstellen kann ####
    89. 'Kalender-Userformposition (ggf. anpassen)
    90. Const cUF_left As Double = 350
    91. Const cUF_Top As Double = 150
    92. Const cbInClpBrd As Boolean = True 'Soll Ergebnis in die Zwischenablage?
    93. Const cbFeiertag As Boolean = True 'Soll Feiertag angezeigt werden?
    94. Private Sub Button_Schließen_Click()
    95. 'Kalender_Maske schliessen
    96. Unload Kalender_Maske
    97. End Sub
    98. Private Sub CommandButton1_Click()
    99. 'Eingaben der Schaltfläche in die Arbeitsmappe übernehmen
    100. Dim last As Long
    101. last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    102. 'Daten in Textbox_Lieferdatum Inventar_Eingabe_Maske übernehmen
    103. Inventar_Eingabe_Maske.TextBox_Lieferdatum = Kalender_Maske.TB_Datum1
    104. 'Daten in Textbox_WartungsDurchsichtsdatum WartungsDurchsichts_Maske übernehmen
    105. WartungsDurchsichts_Maske.TextBox_WartungsDurchsichtsdatum = Kalender_Maske.TB_Datum1
    106. 'Daten in TextBox_ReparaturDatum Reparatur_Maske übernehmen
    107. Reparatur_Maske.TextBox_ReparaturDatum = Kalender_Maske.TB_Datum1
    108. 'Daten in TextBox_KaufdatumDesZubehörs Zubehör_Maske übernehmen
    109. Zubehör_Maske.TextBox_KaufdatumDesZubehörs = Kalender_Maske.TB_Datum1
    110. 'Daten in Textbox_Lieferdatum Aussonderungs_Maske übernehmen
    111. Aussonderungs_Maske.TextBox_TagDerBeräumung = Kalender_Maske.TB_Datum1
    112. End Sub
    113. '### Userform initialisieren ###
    114. Sub UserForm_Initialize()
    115. Dim LB As Control
    116. Me.TB_Datum1.Value = Format("")
    117. aktDat = Date
    118. Heute_zeigen.Caption = "Heute: " & Date
    119. For Each LB In Frame1.Controls
    120. If TypeName(LB) = "Label" And LB.Name <> Heute_zeigen Then
    121. i = i + 1
    122. If i > 0 Then
    123. ReDim Preserve cLabel(1 To i)
    124. Set cLabel(i).Label = LB
    125. End If
    126. End If
    127. Next LB
    128. Call FrameFuellen 'Die Tage und Wochen im Kaleder ausfüllen
    129. End Sub
    130. Sub UserForm_activate()
    131. 'Soll der Caption weggeblendet werden? Ggf. Ausremmen
    132. Caption_Weg Kalender_Maske
    133. If cUF_left > 0 Then Kalender_Maske.Left = cUF_left
    134. If cUF_Top > 0 Then Kalender_Maske.Top = cUF_Top
    135. End Sub
    136. '### Eine Datums/KW-Textbox wurde verändert ###
    137. Sub TB_Datum1_AfterUpdate()
    138. TB_Datum1 = Format(TB_Datum1, "dd.MM.yyyy")
    139. End Sub
    140. '###############################################
    141. '### SpinButton Monat/Jahr geklickt ###
    142. Sub Monat_Minus_Click()
    143. MonatJahrPlusMinus 0, -1
    144. End Sub
    145. Sub Monat_Plus_Click()
    146. MonatJahrPlusMinus 0, 1
    147. End Sub
    148. Sub Jahr_Minus_Click()
    149. MonatJahrPlusMinus -1, 0
    150. End Sub
    151. Sub Jahr_Plus_Click()
    152. MonatJahrPlusMinus 1, 0
    153. End Sub
    154. Sub MonatJahrPlusMinus(dJOffset As Double, dMOffset As Double)
    155. aktDat = DateSerial(Year(aktDat) + dJOffset, Month(aktDat) + dMOffset, 1)
    156. Call FrameFuellen
    157. End Sub
    158. '### Ein Button wurde geklickt ###
    159. Sub Monat_Anzeige_Click()
    160. Me.TB_Datum1.Value = Left$(Me.Monat_Anzeige.Caption, 3) _
    161. & Right$(Me.Monat_Anzeige.Caption, 5)
    162. End Sub
    163. Sub Heute_Zeigen_Click()
    164. 'Das heutige Datum im Kalender selektieren
    165. aktDat = Date
    166. Me.TB_Datum1 = Right$(Me.Heute_zeigen, 10)
    167. Call FrameFuellen
    168. End Sub
    169. Sub Heute_Zeigen_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    170. TB_Datum1.Value = Date
    171. End Sub
    172. '### Ausfüllen des Kalenders mit Tagesdaten ###
    173. Sub FrameFuellen()
    174. 'Füllt den Tageskalender aus
    175. Dim dTag As Date
    176. Frame1.Monat_Anzeige.Caption = Format(aktDat, "mmmm yyyy")
    177. dTag = GetBeginKW(KW(DateSerial(Year(aktDat), Month(aktDat), 1)), Year(aktDat))
    178. Me.LB_Hinweis.Visible = False
    179. For i = 1 To 48
    180. With Frame1.Controls("Label" & i)
    181. Select Case i
    182. Case Is < 7 'Spalte mit den KW füllen
    183. .Caption = KW(DateSerial(Year(aktDat), Month(aktDat), i * 7 - 6))
    184. .Tag = "KW " & Right$("00" & .Caption, 2) & " " & Year(aktDat)
    185. .BackStyle = 0: .BackColor = &HD0D0D0 'Farbe der Wochen
    186. Case Else 'Spalten mit den Tagen füllen
    187. .Tag = dTag
    188. .Caption = Format(dTag, "d") 'Tag formatieren
    189. .ForeColor = IIf(Month(dTag) <> Month(aktDat), _
    190. &HC0C0C0, IIf(Weekday(dTag, 2) > 5, &HFF&, &H0&))
    191. If dTag = Date Then
    192. .BackStyle = 1: .BackColor = &HFFD0D0 'Farbe des aktuelle Tages
    193. Else
    194. .BackStyle = 0: .BackColor = &HD0D0D0 'Farbe der anderen Tage
    195. End If
    196. Call GetFeiertag(ByVal dTag, Frame1.Controls("Label" & i))
    197. dTag = dTag + 1
    198. End Select
    199. End With
    200. Next i
    201. End Sub
    202. Function GetBeginKW(iKW As Integer, iJahr As Integer) As Double
    203. 'Die erste im Kalender zu zeigende Woche ermitteln
    204. Dim dErsterTag As Double
    205. If Month(aktDat) = 1 And iKW > 51 Then iJahr = iJahr - 1
    206. dErsterTag = DateSerial(iJahr, 1, 1)
    207. Do Until DatePart("WW", dErsterTag, 2, 2) = 2
    208. dErsterTag = dErsterTag + 1
    209. Loop
    210. GetBeginKW = DateAdd("WW", iKW - 2, dErsterTag)
    211. End Function
    212. Function KW(Datum As Date) As String
    213. 'Kalenderwoche zum übergebenen Datum ermitteln
    214. Dim L As Long
    215. L = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
    216. KW = ((Datum - L - 3 + (Weekday(L) + 1) Mod 7)) \ 7 + 1
    217. End Function
    218. Function GetFeiertag(ByVal dTag As Date, Optional oCol As Object) As String
    219. Dim FT As String, j As Integer, d As Integer, o As Date
    220. j = Year(dTag)
    221. 'Osterberechnung
    222. d = (((255 - 11 * (j Mod 19)) - 21) Mod 30) + 21
    223. o = DateSerial(j, 3, 1) + d + (d > 48) + 6 - _
    224. ((j + j \ 4 + d + (d > 48) + 1) Mod 7)
    225. 'Feiertage berechnen
    226. Select Case dTag
    227. Case DateSerial(j, 1, 1): FT = "Neujahr"
    228. Case DateSerial(j, 1, 6): FT = "Dreikönigstag*"
    229. Case DateAdd("D", -2, o): FT = "Karfreitag"
    230. Case o: FT = "Ostersonntag"
    231. Case DateAdd("D", 1, o): FT = "Ostermontag"
    232. Case DateSerial(j, 5, 1): FT = "Erster Mai"
    233. Case DateAdd("D", 39, o): FT = "Christi Himmelfahrt"
    234. Case DateAdd("D", 49, o): FT = "Pfingstsonntag"
    235. Case DateAdd("D", 50, o): FT = "Pfingstmontag"
    236. Case DateAdd("D", 60, o): FT = "Fronleichnam*"
    237. Case DateSerial(j, 8, 15): FT = "Maria Himmelfahrt*"
    238. Case DateSerial(j, 10, 3): FT = "Deutsche Einheit"
    239. Case DateSerial(j, 11, 22) - (DateSerial(j, 11, 18) Mod 7)
    240. FT = "Buß- und Bettag*"
    241. Case DateSerial(j, 10, 31): FT = "Reformationstag*"
    242. Case DateSerial(j, 11, 1): FT = "Allerheiligen*"
    243. Case DateSerial(j, 12, 24): FT = "Heilig Abend*"
    244. Case DateSerial(j, 12, 25): FT = "1. Weihnachtstag"
    245. Case DateSerial(j, 12, 26): FT = "2. Weihnachtstag"
    246. Case DateSerial(j, 12, 31): FT = "Silvester"
    247. End Select
    248. GetFeiertag = FT
    249. If oCol Is Nothing Then Exit Function
    250. oCol.ControlTipText = FT
    251. If FT <> "" Then 'Feiertag formatieren
    252. oCol.Font.Bold = True
    253. oCol.BackStyle = 1
    254. oCol.BackColor = &HEFEFFF
    255. If Right$(FT, 1) = "*" Then _
    256. Me.LB_Hinweis.Visible = True
    257. Else
    258. oCol.Font.Bold = False
    259. End If
    260. End Function
    261. '### Eine Maustaste wurde geklickt ###
    262. Sub MouseActions(Label As MSForms.Label, bArt As Byte, Optional iButton As Integer)
    263. Static Label2 As Object
    264. With Label
    265. If .Tag Like "##.##.####" Or .Tag Like "KW #*" Then
    266. Select Case bArt
    267. Case 0: Me.TB_Datum1.Value = .Tag 'DoubleClick
    268. Case 1: .BackStyle = 1
    269. .BackColor = &HD0D0D0 'MouseDown =>Hintergrundfarbe setzen
    270. Case 2 'MouseUp =>Hintergrundfarbe setzen
    271. If iButton = 1 Then
    272. Me.TB_Datum1.Value = .Tag 'Sofortübernahme
    273. Me.TB_Datum1.ControlTipText = .ControlTipText
    274. ElseIf iButton = 2 Then
    275. If Label2 Is Nothing Then
    276. Me.TB_Datum1.Value = .Tag 'Erster Klick
    277. Me.TB_Datum1.ControlTipText = .ControlTipText
    278. Set Label2 = Label: Exit Sub
    279. End If
    280. End If
    281. Call FrameFuellen 'Hintergrundfarben wiederherstellen
    282. Set Label2 = Nothing
    283. End Select
    284. End If
    285. End With
    286. End Sub
    287. Sub Userform_MouseMove(ByVal iButton As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    288. 'Verschieben der Userform mit der Maus (Linksclick Move)
    289. If Y < 15 Then
    290. If iButton <> 1 Then Ptx = 0: Pty = 0: Exit Sub
    291. If (Ptx > 0 And Ptx <> X) Then Me.Left = Me.Left + (X - Ptx)
    292. If (Pty > 0 And Pty <> Y) Then Me.Top = Me.Top + (Y - Pty)
    293. DoEvents
    294. If Ptx = 0 Then Ptx = X
    295. If Pty = 0 Then Pty = Y
    296. End If
    297. End Sub
    298. '### Zusatzfunktionen Caption weg
    299. Sub Caption_Weg(UF As Object)
    300. 'Entfernen des Caption der Userform
    301. Dim tRect As RECT, Pt As POINTAPI
    302. hWnd = FindWindow(vbNullString, UF.Caption) 'Handle besorgen
    303. If hWnd > 0 Then
    304. GetWindowRect hWnd, tRect 'Position und Maße der UF
    305. #If VBA7 Then
    306. frmStyle = GetWindowLongPtr(hWnd, GWL_STYLE) 'Style besorgen
    307. #Else
    308. frmStyle = GetWindowLong(hWnd, GWL_STYLE) 'Style besorgen
    309. #End If
    310. If (WS_CAPTION And frmStyle) = 0 Then Exit Sub 'Caption ist schon weg =>raus
    311. frmStyle = frmStyle And Not WS_CAPTION
    312. #If VBA7 Then
    313. SetWindowLongPtr hWnd, GWL_STYLE, frmStyle 'Neuen Style setzen
    314. #Else
    315. SetWindowLong hWnd, GWL_STYLE, frmStyle 'Neuen Style setzen
    316. #End If
    317. With tRect
    318. Pt.X = .Left + 4: Pt.Y = .Top + 34 'UF neu positionieren
    319. SetWindowPos hWnd, 0, Pt.X, Pt.Y, .Right - Pt.X - 8, .Bottom - Pt.Y - 8, 0
    320. End With
    321. End If
    322. End Sub
    323. Sub KopieInZwischenablage(sCliptext As String)
    324. 'Kopieren von Text über die API
    325. #If VBA7 Then
    326. Dim hMem As LongPtr, lpGMem As LongPtr
    327. #Else
    328. Dim hMem As Long, lpGMem As Long
    329. #End If
    330. hMem = GlobalAlloc(&H42, Len(sCliptext) + 1) 'Speicher bereitstellen
    331. lpGMem = GlobalLock(hMem) 'Speicher blockieren
    332. lpGMem = lstrcpy(lpGMem, sCliptext) 'Daten in den Bereich kopieren
    333. If GlobalUnlock(hMem) = 0 Then
    334. If OpenClipboard(0&) <> 0 Then 'Zwischenablage öffnen
    335. EmptyClipboard 'Zwischenablage leeren
    336. SetClipboardData 1, hMem 'Handle übergeben
    337. CloseClipboard 'Zwischnablage schließen
    338. End If
    339. End If
    340. End Sub


    Außerdem habe ich zur Verdeutlichung noch 2 Screenshots angehängt.

    Danke im Voraus für die Hilfe.

    VG Johanne
    Dateien

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Johanne“ ()