1.9k Aufrufe
Gefragt in Datenbanken von
Guten Tag an Alle,
ich habe das gleiche Problem wie es hier schon oft beschrieben wurde.
Auch habe ich versucht die Lösungen welchen unter:
http://www.vbarchiv.net/tipps/details.php?id=542 und
http://access.mvps.org/access/api/api0046.htm beschrieben sind getestet.
Ich erhalte hier dann immer nachfolgende Fehlermeldung:
"Fehler beim Kompilieren: Nach End Sub, End Function oder End Property können nur Kommentare stehen"

Weiß hier jemand einen Rat?
Danke Stephan

4 Antworten

0 Punkte
Beantwortet von lorf55 Mitglied (699 Punkte)
Hallo,

an welcher Stelle kommt denn die Fehlermeldung?

Klappt
bei meinem Acc2k wunderbar.

Gruß
0 Punkte
Beantwortet von
Hallo,
ich stelle mal den Anfang des Codes ein:
Option Compare Database 'Verwenden der Datenbank-Sortierreihenfolge beim Vergleich von Zeichenfolgen.

Private Sub Adresse_GotFocus()
' Declare Type for API call:
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type

' API declarations:
Private Declare Function GetVersionEx Lib "Kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwflags As Long, ByVal dwExtraInfo As Long)

Private Declare Function GetKeyboardState Lib "user32" _
(pbKeyState As Byte) As Long

Private Declare Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long

' Constant declarations:
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_CAPITAL = &H14
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1

Function IsCapsLockOn() As Boolean
Dim o As OSVERSIONINFO

o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
IsCapsLockOn = keys(VK_CAPITAL)
End Function

Sub ToggleCapsLock()
Dim o As OSVERSIONINFO

o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)

Danke
Stephan
0 Punkte
Beantwortet von
Ja, und dann natürlich auch noch der Orginalcode der die Deaktivierung der NumLook Taste bewirkt.:

Option Compare Database 'Verwenden der Datenbank-Sortierreihenfolge beim Vergleich von Zeichenfolgen.

Private Sub Adresse_GotFocus()
SendKeys "%{DOWN}", True
End Sub

Private Sub Adresse_NotInList(NewData As String, Response As Integer)
On Error GoTo F_Adresse_NotInList
If NewData <> "" Then
If MsgBox("Möchten Sie eine neue Adresse hinzufügen?", 36, "- " + NewData + " - nicht in der Liste") = 6 Then
DoCmd.Echo False
DoCmd.DoMenuItem A_FORMBAR, A_EDIT, A_UNDOFIELD, , A_MENU_VER20
Forms![Postausgang]![Adresse] = ""
DoCmd.OpenForm "Kundenliste", A_NORMAL, , , A_ADD
Forms![Kundenliste].DefaultEditing = 1
Forms![Kundenliste]![Name, Firma] = NewData
Forms![Kundenliste].[SchließenPa].Visible = True
DoCmd.Echo True
End If
End If
Response = DATA_ERRCONTINUE
Exit Sub
F_Adresse_NotInList:
MsgBox Error$
Exit Sub
End Sub

Private Sub Ändern_Click()
Forms![Postausgang]![Adresse].SetFocus
If Not IsNull(Forms![Postausgang]![Adresse]) Then
DoCmd.OpenForm "Kundenliste", , , "[Code] = Forms![Postausgang]![Adresse]"
Forms![Kundenliste]![Schließen].Visible = True
End If
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
If Forms![Postausgang]![Adresse] <> Forms![Postausgang]![Adresse].OldValue And Not IsNull(Forms![Postausgang]![Adresse].OldValue) Then
DoCmd.Beep
MsgBox "Es darf keine andere Adresse eingesetzt werden! Sie wird zurückgesetzt.", 16, "Gespeicherter Postausgang"
Forms![Postausgang]![Adresse] = Forms![Postausgang]![Adresse].OldValue
DoCmd.CancelEvent
End If
End Sub

Private Sub Neu_Click()
On Error Resume Next
DoCmd.Echo False
DoCmd.OpenForm "Kundenliste", A_NORMAL, , , A_ADD
Forms![Kundenliste].DefaultEditing = 1
Forms![Kundenliste].[SchließenPa].Visible = True
DoCmd.Echo True
End Sub

Private Sub Rechnung_Click()
On Error GoTo F_Rechnung_Click
If IsNull([Code]) Then
0 Punkte
Beantwortet von lorf55 Mitglied (699 Punkte)
Hallo,
die API-Funktionen müssen außerhalb von Sub- oder Function-Blöcken definiert werden. Adresse_GotFocus() ist doppelt.
Der nachfolgende Code kompiliert ohne Fehler, aber ob er sinnvoll ist, musst du beurteilen.

Gruß



Option Compare Database 'Verwenden der Datenbank-Sortierreihenfolge beim Vergleich von Zeichenfolgen.

'###### Beginn API-Funktionen außerhalb von Sub- und Function-Blöcken definiert #######
' Declare Type for API call:
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type

' API declarations:
Private Declare Function GetVersionEx Lib "Kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwflags As Long, ByVal dwExtraInfo As Long)

Private Declare Function GetKeyboardState Lib "user32" _
(pbKeyState As Byte) As Long

Private Declare Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long
'###### Ende API-Funktionen außerhalb von Sub- und Function-Blöcken definiert #######


''''''Private Sub Adresse_GotFocus()

' Constant declarations:
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_CAPITAL = &H14
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1

Function IsCapsLockOn() As Boolean
Dim o As OSVERSIONINFO

o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
IsCapsLockOn = keys(VK_CAPITAL)
End Function

Sub ToggleCapsLock()
Dim o As OSVERSIONINFO

o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
End Sub

Private Sub Adresse_GotFocus()
SendKeys "%{DOWN}", True
End Sub

Private Sub Adresse_NotInList(NewData As String, Response As Integer)
On Error GoTo F_Adresse_NotInList
If NewData <> "" Then
If MsgBox("Möchten Sie eine neue Adresse hinzufügen?", 36, "- " + NewData + " - nicht in der Liste") = 6 Then
DoCmd.Echo False
DoCmd.DoMenuItem A_FORMBAR, A_EDIT, A_UNDOFIELD, , A_MENU_VER20
Forms![Postausgang]![Adresse] = ""
DoCmd.OpenForm "Kundenliste", A_NORMAL, , , A_ADD
Forms![Kundenliste].DefaultEditing = 1
Forms![Kundenliste]![Name, Firma] = NewData
Forms![Kundenliste].[SchließenPa].Visible = True
DoCmd.Echo True
End If
End If
Response = DATA_ERRCONTINUE
Exit Sub
F_Adresse_NotInList:
MsgBox Error$
Exit Sub
End Sub

Private Sub Ändern_Click()
Forms![Postausgang]![Adresse].SetFocus
If Not IsNull(Forms![Postausgang]![Adresse]) Then
DoCmd.OpenForm "Kundenliste", , , "[Code] = Forms![Postausgang]![Adresse]"
Forms![Kundenliste]![Schließen].Visible = True
End If
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
If Forms![Postausgang]![Adresse] <> Forms![Postausgang]![Adresse].OldValue And Not IsNull(Forms![Postausgang]!
[Adresse].OldValue) Then
DoCmd.Beep
MsgBox "Es darf keine andere Adresse eingesetzt werden! Sie wird zurückgesetzt.", 16, "Gespeicherter Postausgang"
Forms![Postausgang]![Adresse] = Forms![Postausgang]![Adresse].OldValue
DoCmd.CancelEvent
End If
End Sub

Private Sub Neu_Click()
On Error Resume Next
DoCmd.Echo False
DoCmd.OpenForm "Kundenliste", A_NORMAL, , , A_ADD
Forms![Kundenliste].DefaultEditing = 1
Forms![Kundenliste].[SchließenPa].Visible = True
DoCmd.Echo True
End Sub

Private Sub Rechnung_Click()
'On Error GoTo F_Rechnung_Click
'If IsNull([Code]) Then
'End If
End Sub
...