AW: Doppelklick reagiert nicht mehr
29.12.2007 21:13:00
Wolfgang
Hallo Peter,
anbei die besagten Makros. Mit Aufruf soll eine Internetseite geöffnet werden. Ich hoffe, dass ich nicht noch etwas vergessen habe. Danke schon jetzt für Deine Mühen. - Erwähnen sollte ich noch, dass der Doppelklick auch direkt innerhalb des Tabellenblattes funktioniert (siehe letzten Code - in This Workbook hinterlegt)
Gruß Wolfgang
Option Explicit
Public Zeile As Long
Public Spalte As Long
Public Art As Single
Public Wahl As String
Public Kunummerok As Integer
Public Kunummerwahl As String
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Sub Kunummerprfg()
For Kunummerok = 1 To 3
Select Case Mid(Kunummerwahl, Kunummerok, 1)
Case 0 To 9
Case Else
Exit Sub
End Select
Next Kunummerok
Select Case Mid(Kunummerwahl, 4, 1)
Case "A" To "Z"
Case Else
Exit Sub
End Select
For Kunummerok = 5 To 10
Select Case Mid(Kunummerwahl, Kunummerok, 1)
Case 0 To 9
Case Else
Exit Sub
End Select
Next Kunummerok
Art = 1
End Sub
Sub Aufruf(KdNr As Variant)
Dim myUrl As String
Dim oiE
Dim i As Integer
Dim Suchtext As String
ActiveWorkbook.ActiveSheet.Activate
Kunummersuch
Wahl = Range(VBA.Left(Wahl, 2) & Mid(ActiveCell.Columns(Spalte).Address, 4, 5)).Address
Kunummerwahl = Range(VBA.Left(Wahl, 2) & Mid(ActiveCell.Columns(Spalte).Address, 4, 5)).Value
Select Case Len(Kunummerwahl)
Case 10
Kunummerprfg
Case 18, 19
Case Else
Exit Sub
End Select
Wahl = Range(Wahl).Value
myUrl = "https://www.google.de/"
Set oiE = CreateObject("InternetExplorer.Application")
oiE.Navigate myUrl
Do While (oiE.Busy)
Sleep 200
Loop
oiE.Visible = True
DoEvents
Sleep 500
Do While (oiE.Busy)
Sleep 100
DoEvents
Loop
Sleep 300
For i = 0 To oiE.Document.Links.Length
If oiE.Document.Links(i).outerText = "Maps" Then
oiE.Document.Links(i).Click
Exit For
End If
Next i
Sleep 300
Do While (oiE.Busy)
Sleep 100
DoEvents
Loop
Sleep 500
oiE.Document.forms(0).Kundennummer.Value = Wahl
oiE.Document.forms(0).elements("cmd#suchen").Click
Ende:
Set oiE = Nothing
End Sub
Sub Kunummersuch()
Art = 0
For Zeile = 1 To 25
For Spalte = 1 To 254
On Error Resume Next
Kunummerwahl = Cells(Zeile, Spalte).Value
Select Case Len(Kunummerwahl)
Case 10
Kunummerprfg
Case 18, 19
End Select
If Art 0 Then
Kunummerwahl = Cells(Zeile, Spalte).Value
Wahl = Cells(Zeile, Spalte).Address
Exit Sub
End If
On Error GoTo 0
Next Spalte
Next Zeile
End
End Sub
Public Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Excel.Range, _
Cancel As Boolean)
Dim KdNr As String
KdNr = Range("$I" & Mid(ActiveCell.Columns(1).Address, 4, 4)).Value
Aufruf KdNr
Cancel = True
End Sub
Unter Workbook Open noch folgendes:
Application.OnKey "+^{+}", "Aufruf"