VBA UserForm KeyDown Sonderzeichen werden nicht erkannt?

Hallo, ich habe eine Frage zu meinem VBA Code. Und zwar sollen verschiedene Tastatureingaben verschiedene Funktionen triggern. Bei Zahlen, Buchstaben, Plus, Minus, "&"-Zeichen, "!"-Zeichen und einige andere Tasten gehen. "*"-Zeichen, Prozent, "(" und ")" bspw. gehen jedoch NICHT (als KeyCode wird 0 zurückgegeben). Hat jemand eine Ahnung woran das liegt?

Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  handleKeyDown KeyCode, Shift
End Sub

Private Sub handleKeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim keyChar As String * 1
  keyChar = Chr(KeyCode)
  MsgBox (KeyCode)
  Select Case keyChar
  Case "0"
    numb0_Click
  Case "1"
    numb1_Click
  '.....
  Case Else
  End Select
  Select Case KeyCode
  Case "187"
    plus_Click
  '....
  Case Else 
  End Select
End Sub

Danke für alle Antworten,

Nicolas

2 Antworten

IchMalWiederXY

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel, VBA

21.03.2020, 11:33

Ich bin irritiert, "allles" was du drückst führt zu KeyCode "0" ?
Normalerweise hat jedes Object eine eigene KeyDown Routine.
e.g: eine textBox.
txt.MyTextBox_KeyDown(....)

oder willst du eine 'zentrale' KeyDown Routine für mehrere Objekte hinterlegen?
Teste mal im analogen KeyUp Event, welche Taste dort angeboten wird.
Bei mir hat es mit nem kleinen Testprogramm funktioniert. Habe die Taste "0" gedrückt. Sobald "Shift" in Kombination vorkommt gibt es etwas mehr zu tun.

Bild zum Beitrag

- (Computer, Technik, Spiele und Gaming)

Nic0LP

Beitragsersteller

21.03.2020, 20:24

Hi, sorry, hab mich glaube ich unklar ausgedrückt: Die meisten Zeichen geben den Richtigen KeyCode wert zurück (Zahlen, Buchstaben, einige Sonderzeichen), aber viele (Klammern, Prozentzeichen, etc.) geben 0 zurück.

IchMalWiederXY

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel, VBA

22.03.2020, 08:29

Du musst dich zunächst um das Sonderzeichen kümmern. Shift = 1.
Dann um die weiteren gedrückten Tasten.

Bild zum Beitrag

Ähnliche Beiträge

Wie kann man bei Visual Basic einen Zufallsgenerator erstellen, der zufällige Funktionen durchführt?

Sehr geehrte Nutzer, ich habe ein Visual Basic Programm erstellt, dass unter anderem zufällige Funktionen durchführen soll. Zufällige Formen sollen dargestellt werden (form2.show, me.hide) Mein bereits erstellter Code ist: Dim random As New System.Random Function zufall() Select Case random.Next(0, 1) Case "0" Return form2.Show Me.Hide() Case "1" Return form3.show me.hide() End Select End Function Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click label1.text = (zufall()) End Sub

Hat jemand Verbesserungsvorschläge für diesen Code? Ich denke mal das "Return" ist falsch aber Warum? Wenn es jemand weiß bitte sofort melden. Danke im Vorraus.

...zum Beitrag

Wie ändere ich die Farbe der Blattregisterkarte basierend auf mehrere Zellenwerte?

Das habe ich im Netz gefunden, aber ich brauche die Abfrage für mehrere Zellen (A1:A10)

Kann mir da jemand helfen ??

Gruß Heiko



Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
    If Target.Address = "$A$1" Then
        Select Case Target.Value
        Case "False"
            Me.Tab.Color = vbRed
        Case "True"
            Me.Tab.Color = vbGreen
        Case Else
            Me.Tab.Color = vbBlue
        End Select
    End If
End Sub

...zum Beitrag

VBA Zellen verbinden mit schleife?

Hallo,

ich möchte mit Visual Basic in der Spalte A jeweils die 4 aufeinander folgenden Zellen miteinander verbinden. Also A4 - A7, A8 - A11 usw. In der Zeile mit range spuckt er einen Fehler und ich komme nicht drauf warum. Wäre super, wenn jemand mir helfen könnte 😁

Quellcode:

Option Explicit
Sub Merge()
Dim Counter1 As Integer
Dim Counter2 As Integer
Counter1 = 3
Counter2 = 7
Worksheets(„Tabelle1“).Activate
Do While Counter1 <= 1000
Range(Cells(Counter1,1), Cells(Counter2,1)).Select = True
Selection.Merge
Counter1 = Counter1 + 4
Counter2 = Counter2 + 4
Loop
End Sub

...zum Beitrag

Hallo, ich möchte in einer Excel Datei per vba code bis zur ersten leeren zeile gehen, wie tue ich das?

ich möchte zur ersten leeren Zeile gehen und dann den rest markieren und löschen, also den kompletten Bereich ab da? BSp. A10 ist leer, dann möchte ich ab A10:z10 und abwärts alles markieren und löschen

Wie??

Sub FIND_EMPTY_CELL()

    Dim zeil As Integer
    Dim z As Integer
    Dim leerAbWo As Long

    zeil = ActiveSheet.UsedRange.Rows.Count 'letzte ausgefüllte Zeile

    For z = 8 To zeil

            If Cells(z, 1) = "" Then
                'leere Zelle gefunden
                leerAbWo = Cells(z, 1).Select 'gefundene Zelle selektieren
                'jetzt ab da an bis AA markieren und rest löschen!!!
                MsgBox leerAbWo
                Exit Sub
            End If
    Next z
End Sub

...zum Beitrag

Wo ist der Fehler im Code (VBA PowerPoint)?

Hallo meine lieben,

ich benötige wieder einmal eure Hilfe. Ich habe im Internet einen VBA Code gefunden der es ermöglich in einer PowerPoint Präsentation die aktuelle Uhrzeit mit Sekunden anzuzeigen. Da der Code leider nicht 64bit tauglich war hab ich ein wenig rumgetüftelt und siehe da, die Uhr selbst funktioniert schon mal. Aber leider bekomme ich ständig eine Fehlermeldung sobald die Folie gewechselt wird. "slides (unknown member): bad argument type. Excectet Collection index (string or integer). Ich verwende Windows 10 und Office 2016.

Würde mich rießig freuen wenn mir hier jemand weiterhelfen kann.

Vielen Dank im Voraus.

Leider ist der Code zu lange daher in 2 Teile.

Erster Teil:

Option Explicit

'API Declarations
Declare PtrSafe Function SetTimer Lib "user32" _
                            (ByVal hwnd As LongPtr, _
                             ByVal nIDEvent As LongPtr, _
                             ByVal uElapse As LongPtr, _
                             ByVal lpTimerFunc As LongPtr) As LongLong

Declare PtrSafe Function KillTimer Lib "user32" _
                            (ByVal hwnd As LongPtr, _
                             ByVal nIDEvent As LongPtr) As LongLong

' Public Variables
Public ClockTimerID As LongLong
Public prevSlideIdx As LongLong

Const TIMEFORMATSTRING As String = "dd.mm.yyyy - HH:mm:ss - KW :ww" 'show seconds with: "HH:mm:ss""

Dim pptEventObject As New Klasse1 'AppClassModule
'DIESE METHODE EINMALIG UNTER MAKROS STARTEN, DAMIT DAS EVENTHANDLING FUNKTIONIERT!
Sub InitializeApp()
    Set pptEventObject.App = Application
End Sub


Sub StartClockTimer()
    On Error GoTo ErrorOccurred
    
    'first make sure its not already running
    ClockTimerID = KillTimer(0, ClockTimerID)
    ClockTimerID = SetTimer(0, 0, 1000, AddressOf TimerProcClock)
    If ClockTimerID = 0 Then
        MsgBox "Unable to create the clock timer", vbCritical + vbOKOnly, "Error"
        Exit Sub
    End If

    Exit Sub
ErrorOccurred:
    MsgBox Err.Description
End Sub


Sub StopClockTimer()
    On Error GoTo ErrorOccurred
    
    If Not ClockTimerID = 0 Then
        ClockTimerID = KillTimer(0, ClockTimerID)
    End If

    Exit Sub
ErrorOccurred:
    MsgBox Err.Description
End Sub


' The defined routine gets called every nnnn milliseconds.
Sub TimerProcClock(ByVal hwnd As LongPtr, _
                    ByVal uMsg As LongPtr, _
                    ByVal idEvent As LongPtr, _
                    ByVal dwTime As LongPtr)
On Error GoTo ErrHandler
    
    If Not ActiveSlide Is Nothing Then
        ActiveSlide.Shapes("PointaixClockLabel").TextFrame.TextRange.Text = WeekdayName(Weekday((Now()))) + " " + Format(Now(), TIMEFORMATSTRING)
    End If

    Exit Sub
ErrHandler:
End Sub

...zum Beitrag

Maximale Pfadlänge in Windows und VBA umgehen?

Hallo,

ich benutze folgenden Code in Excel VBA um mir Dateipfad und Dateiname eines Ordners und allen darin enthaltenen Unterordnern aufzulisten.
(Ihr könnt es testen, den Code einfach in ein Modul kopieren, "MainList" ausführen und einen Ordner eurer Wahl auswählen)

Ich habe jetzt das Problem, dass dieser Code alle Dateien überspringt, deren Pfadlänge über 255 Zeichen lang ist. Einige Dateien überschreiten nämlich die 255 Zeichen mit dem angehängten Dateinamen.
Sie liegen aber dennoch ab. Nur liest VBA diese nicht aus. Kann man da was dran machen?

Sub MainList()
'Updateby Extendoffice
Set Folder = Application.FileDialog(msoFileDialogFolderPicker)
If Folder.Show <> -1 Then Exit Sub
xDir = Folder.SelectedItems(1)
Call ListFilesInFolder(xDir, True)
End Sub

Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
  Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Path
  Application.ActiveSheet.Cells(rowIndex, 2).Formula = xFile.Name
  rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
  For Each xSubFolder In xFolder.SubFolders
    ListFilesInFolder xSubFolder.Path, True
  Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub

Function GetFileOwner(ByVal xPath As String, ByVal xName As String)
Dim xFolder As Object
Dim xFolderItem As Object
Dim xShell As Object
xName = StrConv(xName, vbUnicode)
xPath = StrConv(xPath, vbUnicode)
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.Namespace(StrConv(xPath, vbFromUnicode))
If Not xFolder Is Nothing Then
  Set xFolderItem = xFolder.ParseName(StrConv(xName, vbFromUnicode))
End If
If Not xFolderItem Is Nothing Then
  GetFileOwner = xFolder.GetDetailsOf(xFolderItem, 8)
Else
  GetFileOwner = ""
End If
Set xShell = Nothing
Set xFolder = Nothing
Set xFolderItem = Nothing
End Function

...zum Beitrag

VBA Makro gesucht: Inhalt von Zellen löschen wenn eine andere Zelle bestimmten "TEXT" beinhalted?

Hallo Zusammen,

ich bin absoluter VBA neuling, bräuchte aber ein einfaches Makro zu folgendem Fall:

In den Zellen der Spalte R (R6:R150) steht entweder: "STATUS1=grün" oder "STATUS2=gelb" oder "STATUS3=rot".

Wenn zum Beispiel Zelle R6 = "STATUS1=grün" dann sollen die Zellen (I6:J6) und die Zellen (L6:N6) geleert werden
Wenn R6 = "STATUS2=gelb" dann sollen die Zellen (I6:J6) geleert werden
Wenn R6 = "STATUS3=rot" dann soll nichts gelöscht werden.
Wenn R6 = "" (also leer) soll auch nicht gelöscht werden.

--> Gleiches soll für alle Zelle im Bereich (R6:R150) gelten

--> Die Spalten I,J,L,M und N müssen aber befüllbar sein, daher lässt sich das ja nicht über eine Formel machen.

Das ist alles was ich bis jetzt zusammen gebastelt habe: leider funktioniert es nicht:

Private Sub Worksheet_Change(ByVal Target As Range)
'Abfrage, ob Änderung in Zelle A1 erfolgt ist
If Target.Address = "$R$6" Then
    If IsValue(STATUS1 = grün) Then
    
            Range("4:F14").Select
            Selection.ClearContents
    End Select
End If
End Sub

Vielen Dank für eure Hilfe.

...zum Beitrag

Visual Basic - Wie nutzt man Windows speech recognition richtig?

Hallo, seit langem suche ich schon seit langem nach einer Lösung im Internet system speech recognition in VB gescheit nutzen zukönnen. Bisher habe ich folgendes gefunden und genutzt.

//////////////////////

Imports System.Speech Public Class Form1

Public synth As New Speech.Synthesis.SpeechSynthesizer

Public WithEvents recognizer As New Speech.Recognition.SpeechRecognitionEngine

Dim gram As New System.Speech.Recognition.DictationGrammar()

Public Sub GotSpeech(ByVal sender As Object, ByVal phrase As System.Speech.Recognition.SpeechRecognizedEventArgs) Handles recognizer.SpeechRecognized

words.Text = phrase.Result.Text

End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

recognizer.LoadGrammar(gram)

recognizer.SetInputToDefaultAudioDevice()

recognizer.RecognizeAsync()

End Sub

End Class

//////////////////////

Nur leider versteht mich in diesem Falle Vb kaum. Zb. wenn ich "Nur ein Test" sage versteht Vb "Blaum ein Text" Und wenn ich Cortana einmal das selbe sage versteht sie es... Und da ich einfach keine Lösung in bereits vorhandenen Threads finde hoffe ich das mir netterweise einer von euch helfen könnte. :)

...zum Beitrag

Excel VBA Button Enable?

Hallo Freunde,

Ich habe einen Button in Excel implementiert, der sichtbar sein soll wenn meine Zelle A1 die Zahl 2 enthält.

Der Code dafür lautet:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
  On Error GoTo ErrHandler
  Dim rngButton1 As Integer
  rngButton1 = A1
  If rngButton1 = 2 Then
  CommandButton1.Enabled = False
  Else
  CommandButton1.Enabled = True
  End If
  Application.EnableEvents = True
Exit Sub
ErrHandler:
Application.EnableEvents = True
End Sub

Der Code funktioniert an und für sich, es kommt zu keiner Fehlermeldung.
Aber der Button bleibt egal was ich einstelle, Sichtbar.

Wo liegt der Fehler?

...zum Beitrag

Beim ändern einer bestimmten Zelle Makro erneut ausführen?

Hallo,

ich habe folgendes Anliegen: Ich möchte in Excel mit VBA etwas machen. Hier einmal der Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("j10")) Is Nothing Then
    Select Case Range("j10").Value
        Case "manuell"
            Range("s7:u7").ClearContents
        Case "Anfang & Ende"
            Range("s7").Value = Worksheets("PEPStauchung").Range("d2").Value
    End Select
End If
End Sub

Ich möchte, dass, wenn ich in Zelle S6 einen Wert ändere, das ganze erneut durchgeführt wird.

Wie binde ich das ein? Vielen Dank!!!

Syrena

...zum Beitrag

VB.NET / SharpDevelop: Zahlen sortieren?

Unser Lehrer hat uns die Aufgabe gegeben, in SharpDevelop einen Zufallsgenerator zu erstellen und die Zahlen von der kleinsten aufsteigend zur größten zu sortieren. Ich weiß aber nicht, wie ich die Zahlen sortiere.

Was ich bisher programmiert habe:

  Dim Feld1() As Integer 'globale Variable
  
  Sub Cmd_zzClick(ByVal sender As Object, ByVal e As EventArgs)
    Dim anz, i, zz, z1 As Integer
    Randomize 'Zufallszahlengenerator
    anz = TXT_zz.Text
    ReDim Feld1(anz - 1)
    
    For i = 0 To anz - 1
      zz = int(rnd() * anz) 'auf ganze Zahlen runden
      Feld1(i) = zz
    Next i
  
    LST_zz.Items.Clear
    WriteToLST()
  End Sub
  
  Sub WriteToLST()
    Dim i, anz As Integer
    anz = Feld1.GetUpperBound(0)
  
    For i = 0 To anz
      Lst_zz.Items.Add(Feld1(i))
    Next i
  End Sub
End Class

...zum Beitrag

Kann man den Benutzernamen in einem UserForm Label angeben, der das Dokument geöffnet hat?

Hi, ich liebe Herausforderungen und komme auch nach und nach weiter. Nun habe ich diese Funktion welche prüft, ob eine bestimmte Datei geöffnet ist:

Public Function IsFileOpen(FileName As String)
    Dim filenum As Integer, errnum As Integer
    On Error Resume Next
    filenum = FreeFile()
    Open FileName For Input Lock Read As #filenum
    Close filenum
    errnum = Err
    On Error GoTo 0
    Select Case errnum
    Case 0
    IsFileOpen = False
    Case 70
    IsFileOpen = True
    Case Else
    Error errnum
    End Select
End Function

Mit dieser Funktion kann ich arbeiten, wenn das Dokument von wem auch immer geöffnet ist, öffnet sich eine UserForm.

Nun möchte ich gerne mit dieser Funktion ermitteln, welcher Benutzer das Dokument geöffnet hat:

Public Function LastUser(strPath As String) As String
    Dim strXl As String
    Dim strFlag1 As String, strflag2 As String
    Dim i As Integer, j As Integer
    Dim hdlFile As Long
    Dim lNameLen As Byte
   
    strFlag1 = Chr(0) & Chr(0)
    strflag2 = Chr(32) & Chr(32)
   
    hdlFile = FreeFile
    Open strPath For Binary As #hdlFile
        strXl = Space(LOF(hdlFile))
        Get 1, , strXl
    Close #hdlFile
   
    j = InStr(1, strXl, strflag2)
   
    #If Not VBA6 Then
        '// Xl97
        For i = j - 1 To 1 Step -1
            If Mid(strXl, i, 1) = Chr(0) Then Exit For
        Next
        i = i + 1
    #Else
        '// Xl2000+
        i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
    #End If
   
    '// IFM
    lNameLen = Asc(Mid(strXl, i - 3, 1))
    LastUser = Mid(strXl, i, lNameLen)
End Function

Aber das klappt nicht...

Ich habe es mit diesem Code probiert und diesen an meinen Pfad und das Dokument angepasst:

Private Sub TestVBA()
'http://www.xcelfiles.com/IsFileOpenVBA.htm
'// Just change the file to test here
Const strFileToOpen As String = "C:\Data.xls"
If IsFileOpen(strFileToOpen) Then
MsgBox strFileToOpen & " is already Open" & _
vbCrLf & "By " & LastUser(strFileToOpen), vbInformation, "File in Use"
Else
MsgBox strFileToOpen & " is not open", vbInformation
End If
End Sub

Bekomme immer Fehler 52.

Ich würde aber gerne den Benutzernamen auch später in der UserForm (anstatt einer MsgBox) im Label anzeigen, was ich ebenfalls nicht hinbekomme.

Weiß jemand, wie ich den Benutzernamen ermittel, der das Dokument geöffnet hat und ich diesen dann in den Label-Text einbauen kann? Oder geht das nicht?

Vielen herzlichen Dank im Voraus.

...zum Beitrag

Die anweisung ist in einem Namespace ungültig?

Ich habe eine Anleitung aus dem Internet für ein Zahlen generator kopiert

Dim Zahl As Integer 'zufallsgenerierte Zahl Dim Counter As Integer 'Zähler der Versuche

Private Sub btn_click_Click()

Dim Eingabe As Integer 'Eingegebene Zahl

'Zufallszahl generieren If Zahl = 0 Then Zahl = Int((Rnd() * 100) + 1) End If

'geschätzte Zahl eingeben Eingabe = tb_eingabe.Value

'Gültigkeitsprüfung If Eingabe > 100 Or Eingabe < 1 Then MsgBox ("Bitte geben Sie eine Zahl zwischen 1 und 100 ein!") tb_eingabe.Value = "" Else 'Richtige Eingabe If Eingabe = Zahl Then Cells(Counter + 2, 1) = Eingabe Cells(Counter + 2, 2) = "geschätzte Zahl richtig!"

    'Abfrage zum erneuten Spielen
    Abfrage = MsgBox("Richtig! Gebrauchte Versuche: " & Counter + 1 & vbLf & "Wollen Sie noch einmal spielen?", vbYesNo)
    If Abfrage = vbNo Then
        Application.Quit
    Else
        Columns("A:B").Select
        Selection.ClearContents
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "geschätzte Zahl"
        Range("B1").Select
        ActiveCell.FormulaR1C1 = "Tipp"
        Range("A2").Select
        Zahl = 0
        Counter = 0
        tb_eingabe.Value = ""
        Exit Sub
    End If
End If

'eingegebene Zahl ist größer
If Eingabe > Zahl Then
    Cells(Counter + 2, 1) = Eingabe
    Cells(Counter + 2, 2) = "geschätzte Zahl zu groß"
    tb_eingabe.Value = ""
    Counter = Counter + 1
End If

'eingegeben Zahl ist kleiner
If Zahl > Eingabe Then
    Cells(Counter + 2, 1) = Eingabe
    Cells(Counter + 2, 2) = "geschätzte Zahl zu klein"
    Counter = Counter + 1
    tb_eingabe.Value = ""
End If

End If

End Sub

als Fehler kommen Die anweisung ist in einem Namespace ungültig wenn ich rauf klicke markiert er

Dim Zahl As Integer Dim Counter As Integer

Private Sub btn_click_Click()

(ganz oben) kann mir wer den code richtig machen?

...zum Beitrag

VBA Counter Problem?

Hallo Zusammen,

ich hab ein Problem in VBA. Ich muss bei jedem klicken auf Raten den counter +1 erhöht werden. Leider ergibt sich bei mir eine Endlos-Schleife. Brauche Hilfe.

Private Sub btnRaten_Click()
Dim Userzahl As Integer 'Eingegebene Zahl
Dim PCzahl As Integer 'Zufallszahl
Dim anzahl As Integer
Dim Ende As Boolean


anzahl = 0


PCzahl = Int((Rnd() * 100) + 1)


Userzahl = Val(tbxEingabe.Value)


Ende = False


Do Until Ende = True


anzahl = anzahl + 1


If Userzahl < PCzahl Then
lblAusgabe = "Die Zahl " & Userzahl & " ist zu klein"
Ende = False


ElseIf Userzahl > PCzahl Then
lblAusgabe = "Die Zahl " & Userzahl & " ist zu groß"
Ende = False


ElseIf Userzahl = PCzahl Then
lblAusgabe = "Gewonnen!"
Ende = True


End If


lblCounter.Caption = anzahl
Loop


End Sub

Danke für eure Hilfe.

...zum Beitrag

Was möchtest Du wissen?

Deine Frage stellen