Hey guys, I hope you can help me. Some guys in my firm are getting this error in excel while using 365. I have 2016, so it works fine for me, but I should check it. I already add PtrSafe and long Ptr, now the error does not come directly when the file is open but it comes still after you want to type something in. The same error.
Code:
Public varLezteSpalte As Integer '-------Letzte spalte bestimmen
Public varZeileAkteullesDatum As Integer
Public varUserNamen As String '-------Name, Vorname des Users funktion von Windowsuser
Public varUserSpalte '--------Spalte für Eintrag funktion von Name,Vorname
Public varTagAnfang As Integer
Public varTagEnde As Integer
Public varFlag As Boolean
Public varAnzahlAn As Integer
Public varUrlaub As Boolean
Public TagName As String
Public TagNummer As Integer
Public Zustand As Boolean
Public varKnopfNr As Integer
Public varEintrag As String
Public varFarbe
Public varFarbeTab
Public varSchalterDatum '----------aktivesDatum um Kalender auf aktuelles Datum oder ab 1.1. zu setzten
Public CalenderFeld(35) As Object
Public konJahr As Date
Public Const konPass = "ENP"
Public Const konSpalteAnfang = 8 '----------SpaltenNummer vor ersten Nameneintrag
Public Const konSpalteDatum = 3 '----------SpaltenNummer wo das Datum eingetragen ist.
Public Const konZeileKopf = 2 '----------ZeillenNummer wo die Namen der MA stehen
Public Const konZeileAnfang = 10 '----------ZeillenNummer wo das erste Datum eingtragen ist
Public Const konFeiertag = 6 '----------SpalteNummer wo der Vermerk für Feiertage eingetragen ist
Public Const konSpalteProjektFiltern = 7
Public Const konSpalteDATA = 7
Public TextEintrag As String
Public KeinEintrag As Boolean
Public SelectSpalte
Public SelectZeile
Public SelectRange
Public SelectRangeSpalten
Public MaskeEintrag As Boolean
' ______________________________________Variable für die Abfrage der Windows Usernamme
Public sBuffer(255) As String
Public WindowsXUser '--------Windows Usernamme
Public Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As LongPtr) As Long
Public Const MaxZeichen = 260
Sub UserAbfragen()
On Error Resume Next
'__________________________abfrage des WindowsUser Name (z.B dul2si)
Dim sBuffer As String
Dim lSize As LongPtr
Dim Kontrolle
sBuffer = Space$(255)
lSize = Len(sBuffer)
Call GetUserName(sBuffer, lSize)
If lSize > 0 Then
WindowsXUser = Left(sBuffer, lSize - 1)
Else
WindowsXUser = vbNullString
MsgBox "Achtung User nicht definiert. Bitte Programmierer benachrirtigen"
End
End If
'__________________________abfrage des Name + Vorname (z.B Drutu, Lorenz)
I = 2
Do While Worksheets("User").Cells(I, 1) <> ""
If UCase(Worksheets("User").Cells(I, 3)) = UCase(WindowsXUser) Then
varUserNamen = Worksheets("User").Cells(I, 1) & ", " & Worksheets("User").Cells(I, 2)
End If
I = I + 1
Loop
If varUserNamen = "" Then
MsgBox "User nicht in der Tabelle eingetragen"
UserEintrag '----Macro zur Eintragung in der Tabelle des Windows UserName
End 'Exit Sub
End If
'__________________________abfrage der Spalte (z.B Spalte 19)
SpalteUserAbfragen
If Err.Number <> 0 Then
MsgBox Err.Description & " Programmfehler in UserAbfragen"
Err.Clear
End If
End Sub
Sub LezteSpalte()
On Error Resume Next
Dim J As Integer
J = 1
While Sheets("Anwesenheitsliste").Cells(konZeileKopf, J + konSpalteAnfang) <> ""
varLezteSpalte = J + konSpalteAnfang
J = J + 1
Wend
If Err.Number <> 0 Then
MsgBox Err.Description & " Programmfehler in LezteSpalte"
Err.Clear
End If
End Sub
Sub UserEintrag()
umfUserEintrag.Show
End Sub
Sub SpalteUserAbfragen()
'--------------------------------------------------------------bestimmen der varUserSpalte (= Name, Vorname in der Tabelle )
On Error Resume Next
With Sheets("Anwesenheitsliste")
I = 1
While .Cells(konZeileKopf, I + konSpalteAnfang) <> ""
If varUserNamen = .Cells(konZeileKopf, I + konSpalteAnfang) Then
varUserSpalte = I + konSpalteAnfang
End If
I = I + 1
Wend
If IsEmpty(varUserSpalte) Or varUserSpalte < 0 Then
MsgBox "Name " & varUserNamen & " in der Abwesenheitsliste nicht Richtig eingetragen"
Exit Sub
End If
End With
If Err.Number <> 0 Then
MsgBox Err.Description & " Programmfehler in SpalteUserAbfragen"
Err.Clear
End If
End Sub
Sub NameUndGruppeAbfragen()
I = 9
While Sheets("Gruppe").Cells(11, I) <> ""
J = 2
While Sheets("User").Cells(J, 5) <> ""
If Sheets("User").Cells(J, 5) = Sheets("Gruppe").Cells(11, I) Then
Sheets("Gruppe").Cells(12, I) = Sheets("User").Cells(J, 4)
GoTo Weiter
End If
J = J + 1
Wend
Weiter:
I = I + 1
Wend
End Sub