Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1872to1876
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

On Error

On Error
05.03.2022 20:54:16
oraculix
Hallo Alle!
In meiner Userform habe ich einen VBA Code der sich manchmal nicht oft aber doch aufhängt (Excel muss Abgebrochen werden)
Frage:
Wie kann ich einen Absturz verhindern ?
Welcher Code ist besser On Error Resume next oder On Error Resume Exit Sub? Oder gibt es noch was besseres?
Bin für jeden Vorschlag dankbar den ich noch in den untenstehenden Code einfügen kann.
'bei Return Makro ausführen

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
Dim TB As Worksheet, rng As Range, C As Range, TTXT As String, firstAddress As String
Dim Anz As Integer, JaNein As Variant, Arr, i As Integer
Set TB = Sheets("Schauspieler")
Set rng = TB.Range("A1:IZ300")
With TextBox1
If .Text  "" Then
Set C = rng.Find(.Text, lookat:=xlPart)
If Not C Is Nothing Then
firstAddress = C.Address
Do
Set C = rng.FindNext(C)
' Fundstellen sammeln
TTXT = TTXT & "; " & C.Address(0, 0)
Anz = Anz + 1
Loop While Not C Is Nothing And C.Address  firstAddress
Arr = Split(TTXT, "; ") 'Array zum Anspringen
For i = 1 To Anz
JaNein = MsgBox(Anz & "x gefunden in:" & vbLf & TTXT & vbLf & vbLf _
, vbYesNo, "Zum Treffer " & i & " / " & Anz & " hinspringen?   J / N")
If JaNein = vbYes Then
Application.Goto Range(Arr(i))
Else
Exit For
End If
Next
Else
MsgBox "Kein Fund"
End If
End If
End With
End If
End Sub
Gruß
Oraculix

35
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: On Error
05.03.2022 21:07:25
ralf_b

Wie kann ich einen Absturz verhindern ?  ..... Oder gibt es noch was besseres?
Ja und Ja. Finde den Absturzgrund und vermeide das Entstehen das Fehlers. Fehlerbehandlung abschalten führt eher zu weiteren seltsamen Erscheinungen.
AW: On Error
05.03.2022 21:19:38
oraculix
Danke ralf_b !
Aber Excel zeigt ja keinen Fehler sondern eine Eieruhr und ich kann nichts machen !
Hilft nur Strg+Alt+Entf Excel Beenden!
Gruß
Oraculix
AW: On Error
05.03.2022 22:25:47
ralf_b
Ich gehe davon aus das du dann nicht mal bis zur Messagebox kommst. Dann wäre es also bei der Suche.
dir ist schon klar das du 78000 Zellen durchsuchst?
eine Kleinigkeit Application.Goto TB.Range(Arr(i))
und die Objekte am Ende auf Nothing setzen.
Dim TB As Worksheet, rng As Range, C As Range
Anzeige
AW: On Error
05.03.2022 23:24:56
oraculix
Danke !
Dim TB As Worksheet, rng As Range, C As Range
wenn ich Deinen Code einsetzte geht es nicht!
Application.Goto TB.Range(Arr(i))
Habe ich erfolgreich geändert
und die Objekte am Ende auf Nothing setzen.
Was meinst Du damit?
Jetzt kommt zwar kein Fehler mehr aber wenn es zb. 3Treffer gibt springt er nur den letzten Treffer an aber die ersten beiden werden in der MsgBox angezeigt.

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
'bei Return Makro ausführen
'Dim TB As Worksheet, rng As Range, C As Range 'wenn ich Deinen Code einsetzte geht es nicht!
Dim TB As Worksheet, rng As Range, C As RangeTreffer gibt ste, TTXT As String, firstAddress As String
Dim Anz As Integer, JaNein As Variant, Arr, i As Integer
Set TB = Sheets("Schauspieler")
Set rng = TB.Range("A1:IZ300")
With TextBox1
If .Text  "" Then
Set C = rng.Find(.Text, lookat:=xlPart)
If Not C Is Nothing Then
firstAddress = C.Address
Do
Set C = rng.FindNext(C)
' Fundstellen sammeln
TTXT = TTXT & "; " & C.Address(0, 0)
Anz = Anz + 1
Loop While Not C Is Nothing And C.Address  firstAddress
Arr = Split(TTXT, "; ") 'Array zum Anspringen
For i = 1 To Anz
JaNein = MsgBox(Anz & "x gefunden in:" & vbLf & TTXT & vbLf & vbLf _
, vbYesNo, "Zum Treffer " & i & " / " & Anz & " hinspringen?   J / N")
If JaNein = vbYes Then
'Application.Goto Range(Arr(i))
Application.Goto TB.Range(Arr(i))
Else
Exit For
End If
Next
Else
MsgBox "Kein Fund"
End If
End If
End With
End If
On Error GoTo ErrorHandler
Exit Sub
ErrorHandler:
Resume Next
End Sub

Anzeige
AW: On Error
06.03.2022 00:00:18
ralf_b
da hab ich wohl zu optimistisch hinsichtlich deiner Kenntnisse gedacht.
die Objekte rng, C, TB
setzt man auf Nothing in dem man den Befehl z.b. set rng = nothing am Ende des Codes einfügt. Damit geht man sicher das der Speicherplatz freigegeben wird.
Das funktioniert nur wenn man nicht vorher exit sub auslöst.
deine for Schleife hat mich schon gewundert aber ich denke halt du weist was du da tust oder bekommen hast. Wenn du dir im Klaren bist wie die Suchergebnisse abgearbeitet werden sollen, dann kannst du das sicher selbst lösen. is ja nur ne Ablaufsteuerung.
AW: On Error
06.03.2022 00:23:43
oraculix
Danke
Könntest Du mir mal den ganzen Code Posten Wie Du Dir das vorstellst?
Ich schaff das einfach nicht das ist mir zu hoch!
Danke
Anzeige
AW: On Error
06.03.2022 00:32:35
ralf_b
nein, denn ich weis nicht wie du das handhaben möchtest.
AW: On Error
06.03.2022 00:49:27
oraculix
Danke
Ich möchte in der Userform in die TexBox was eingeben und in der Tabelle suchen. Die MsgBox gibt dann den gefundenen Treffer aus
und springt zur Zelle in der Tabelle. Die User Form ist Showmodal False immer sichtbar.
Gruß
Oraculix
AW: On Error
06.03.2022 11:44:04
ralf_b
ich weis was du generell vorhast. Aber wie du die einzelnen Treffer abarbeiten willst ist mir nicht ganz klar. Es gibt da schließlich mehrere Möglichkeiten.
0 Treffer
1 Treffer
x Treffer - Anzeigen Ja/Nein - was bei Ja , was bei Nein usw.
Wenn du das bis zu Ende gedacht hast, schreib es dir auf und entwickle einen PAP Programmablaufplan. Dann dürfte es dir leichtfallen entsprechende Codes zu entwickeln.
Ich habe keine Lust dir das abzunehmen. Wir erwarten das du langsam mehr von dem verstehst was du hier ständig geliefert bekommst. Für meinen Geschmack schon viel zu viel, weil du mit jeder Frage hier beweist das es dir an den einfachsten Kenntnissen fehlt.
viel Erfolg
Anzeige
AW: Arbeitsmappe Hochgeladen
06.03.2022 12:16:10
oraculix
Danke!
Der Code dürfte einwandfrei sein es muss irgendein anderer Code das einfrieren verursachen.
Leider kann ich nicht die ganze Arbeitsmappe hier einstellen wegen der 300kb.
Deshalb war ja die grundlegende frage wie ich so ein Einfrieren vermeiden kann?
Aber hier ein Teil der Arbeitsmappe man kann erkennen das code Funktioniert.
https://www.herber.de/bbs/user/151585.xlsm
Gruß
Oraculix
von vorne....
06.03.2022 14:51:06
vorne....
ich kann kein Hängenbleiben feststellen.
Deshalb war ja die grundlegende frage wie ich so ein Einfrieren vermeiden kann?
und ich wiederhole mich.
finde die Ursache und vermeide das Auftreten ohne die Fehlerbehandlung komplett abzuschalten.
Anzeige
Vielleicht hat jemand anders einen Rat für mich!
06.03.2022 15:36:53
oraculix
Danke
Ich finde den Fehler nicht hab schon sehr viel ausprobiert !
Wie lautet der VBA Code wenn Fehler dann Abbrechen?
Gruß
Oraculix
AW: Vielleicht hat jemand anders einen Rat für mich!
06.03.2022 22:54:54
Alwin
Teste mal:

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If Not KeyCode = 13 Then
Exit Sub
Else
Dim TB As Worksheet, rng As Range, C As Range, TTXT As String, firstAddress As String
Dim Anz As Integer, JaNein As Variant, Arr, i As Integer
Set TB = Sheets("Schauspieler")
Set rng = TB.Range("A1:IZ80")
With TextBox1
If .Text  "" Then
Set C = rng.Find(.Text, lookat:=xlPart)
If Not C Is Nothing Then
firstAddress = C.Address
Do
Set C = rng.FindNext(C)
' Fundstellen sammeln
TTXT = TTXT & "; " & C.Address(0, 0)
Anz = Anz + 1
Loop While Not C Is Nothing And C.Address  firstAddress
Arr = Split(TTXT, "; ") 'Array zum Anspringen
For i = 1 To Anz
JaNein = MsgBox(Anz & "x gefunden in:" & vbLf & TTXT & vbLf & vbLf _
, vbYesNo, "Zum Treffer " & i & " / " & Anz & " hinspringen?   J / N")
If JaNein = vbYes Then
Application.Goto Range(Arr(i))
Else
Exit For
End If
Next
Else
MsgBox "Kein Fund"
End If
End If
End With
End If
End Sub
Was Ralf_b meint ist zutreffend. Wenn ein Fehler auftritt, sollte man sich eine Strategie überlegen, welcher den Fehler gar nicht erst entstehen lässt. Hier ist das Problem, das bei jeder Tasteneingabe die Prozedur feuert, auch wenn noch kein verwertbares Zeichen in der Textbox drinsteht.
Bei keinem Fund macht es Sinn die Textbox zu leeren.
Gruß Uwe
Anzeige
AW: Vielleicht hat jemand anders einen Rat für mich!
06.03.2022 23:13:36
Alwin
Falls es immer noch Probleme macht, entlade die beiden Objektvariablen: Set .....
AW: Vielleicht hat jemand anders einen Rat für mich!
07.03.2022 07:19:39
oraculix
Hallo und Danke für Deine Mühe.
Habe Deinen Code versucht, genau das gleiche Excel friert ein hilft nur Ein Strg+Alt+Entf Excel beenden.
Es liegt nicht an diesem Code es muss was anderes sein. Habe ja eine Testarbeitsmappe hochgeladen da kann man das gut erkennen das er wunderbar funktioniert. Es muss ein anderer VBA Code sein der der den Fehler auslöst.
Falls es immer noch Probleme macht, entlade die beiden Objektvariablen: Set .....
Was meinst Du damit? entladen wie?
Gruß
Oraculix
Anzeige
AW: Vielleicht hat jemand anders einen Rat für mich!
07.03.2022 09:19:51
Alwin
z.B. ist TB eine von den beiden.
link zum entladen von Objektvariablen (Google in 5 Sekunden gefunden):
In Standartmodulen braucht man Diese fast nie zu entladen, aber eben nur fast.
https://www.herber.de/forum/archiv/724to728/727128_Objektvariablen_loeschen.html
Einen Tipp, um das fehlerauslösende Ereignis zu finden: Haltepunkte in allen mit dem Tabellenblatt verquickten Prozeduren setzten. Die Userform starten und dann mit F8 Schritt für Schritt durchgehen, bis es zum Überlauf kommt. Da hier Keiner Hellsehen kann und nur dieser Ausschnitt vorliegt, bleibt dir wohl nur dieser Weg übrig.
Vielleicht noch ein kleiner Tipp. Code aus dem Netz kann manchmal hilfreich sein. Da diese Prozeduren aber meistens auf eine Problematik zugeschnitten sind, entstehen in anderen Zusammenhängen neue unerwartete Probleme. Besser man beschäftigt sich mit VBA oder was auch immer.
Gruß Uwe
Anzeige
AW: Vielleicht hat jemand anders einen Rat für mich!
07.03.2022 11:13:19
oraculix
Danke ist mir zu hoch das ganze .
Ich wüste gar nicht wie ich halte Punkte setzten soll und wo?
Ich bin doch noch Anfänger mach das erst seit ca.6 Monaten
Gruß
Oraculix
AW: Vielleicht hat jemand anders einen Rat für mich!
07.03.2022 11:30:56
ChrisL
Hi
Den ganzen Beitrag habe ich nicht gelesen, aber hier eine kleine Hilfe zum Haltepunkt, Einzelschrittmodus etc.
https://www.youtube.com/watch?v=s62RapTIwTc
cu
Chris
AW: Vielleicht hat jemand anders einen Rat für mich!
07.03.2022 12:31:15
Alwin
Hallo Oraculix,
ich mache das gerade mal seit reichlich 2 Jahren - ja ein klein wenig länger wie du. Habe es weder studiert noch hat es was mit meinem Beruf zu tun. Es ist reines Hobby. Kompliziert ist es nur, so lang bis man Weiß was wie passiert. Dazu gehört neben dem Lernen der Vokabeln auch das Ablaufen von den damit im Zusammenhang stehenden Abläufen/Prozessen zu erkennen und zu lesen. Daraus ergeben sich die logischen Schlüsse für die Fehlererkennung/-Vermeidung.
Gruß Uwe
Anzeige
AW: Vielleicht hat jemand anders einen Rat für mich!
07.03.2022 13:14:51
oraculix
Danke konnte einiges lernen durch das Video!
Aber hilft mir nicht ich kann ja nichts machen weil Excel einfriert.
Gruß
Oraculix
AW: Vielleicht hat jemand anders einen Rat für mich!
07.03.2022 13:21:07
GerdL
Datei kopieren, in der Kopie alle Makros entfernen, diese einzeln reinkopieren, testen, solange bis der Fehler auftritt. So kommst du normalerweise an die verursachende Prozedur.
AW: Vielleicht hat jemand anders einen Rat für mich!
07.03.2022 13:38:34
oraculix
Danke für den Tipp!
Hab ich schon gemacht habe sicher insgesamt 200 stück drinnen. Da bin ich schneller wenn ich alles neu Aufsetzte. Übrigens schon 3 mal neu begonnen jetzt reichts ich lass die suche einfach weg.
Ich versuche jetzt mal
Folgendes
On Error GoTo Errohändler
VBA Code
Errohändler:
hier weis ich nicht wie ich das schreiben soll das er anhält wenn ein fehler kommt und mir den Fehler zeigt.
Gruß
Oraculix
AW: Vielleicht hat jemand anders einen Rat für mich!
07.03.2022 13:57:16
ChrisL
Hi
Wie Daniel, würde ich ebenfalls eine Endlosschleife vermuten. Diese lässt sich im Einzelschrittmodus aufdecken. Ein Error-Handling nützt hierfür nichts.
Und was GerdL vorschlägt, kann man übrigens auch umgekehrt machen. Die Mappe kopieren, etwas Code löschen und testen. Bei Bedarf wiederholen und etwas mehr Code löschen. Solange bis der Fehler nicht mehr auftritt. Der zuletzt gelöschte Code-Teil wäre dann die Ursache.
cu
Chris
AW: Vielleicht hat jemand anders einen Rat für mich!
07.03.2022 12:45:12
Daniel
Hi
Haltepunkte setzt du, indem du im VBA-Editor auf den linken Rand klickst, dort erscheint dann ein brauner Punkt. Dort stoppt das Makro dann und du kannst im einzelstep weiter durchs Programm gehen und Zeile für Zeile ausführen lassen (F8)
Der Abbruch bei einem Fehler ist eigentlich das normale Verhalten ohne irgendwelche "On Error Gotos", deswegen sollte man die weglassen, wenn man auf Fehlersuche geht.
Ein Einfrieren deutet aber nicht auf einen Fehler hin, sondern auf eine Endlosschleife.
Das kann passieren bei:
- Do Loop ohne oder mit nie erreichter Abbruchbedingung
- EventMakros, die sich selber aufrufen
- Sprünge im Programm (Goto, auch mit in Error), bei denen im Programmablauf zurückgesprungen wird.
Nochmal zum Fehlerabbruch, wenn man mit Userformen arbeitet, sollte man in den Extras - Optionen - Allgemein (?) einstellen, dass der Abbruch " im Klassenmodul" erfolgen soll.
Sonst landest du bei einem Fehlerabbruch immer beim Userform1.Show und nie dort, wo der Fehler im Code passiert.
Gruß Daniel
AW: Vielleicht hat jemand anders einen Rat für mich!
07.03.2022 12:56:14
oraculix
Danke Daniel
Habe das gemacht mit Extras "Klassenmodul" nütz aber nichts Excel friert ein und ich kann nichts machen.
Gruß
Oraculix
AW: Vielleicht hat jemand anders einen Rat für mich!
07.03.2022 13:28:34
Daniel
Ja, das berifft ja auch nur Fehler, die einen Abbruch erzeugen.
Ein Einfrieren ist kein Fehler, sondern eine Aktion, die VBA nicht beendet oder beenden kann.
Entweder weils wirklich lange dauert, oder weil eine Endlosschleife gestartet wurde.
Zum Thema Endlosschleife hatte ich was geschrieben.
Gruß Daniel
AW: Vielleicht hat jemand anders einen Rat für mich!
07.03.2022 13:43:49
oraculix
Danke!
Wie kann ich den Errohändler richtig schreiben?
On Error GoTo Errorhändler
VBA Code
Errorhändler:
Hier weis ich nicht weiter er sollte den Error anhalten und anzeigen wie schreibt man das?
Gruß
Oraculix
AW: Vielleicht hat jemand anders einen Rat für mich!
07.03.2022 13:53:42
Alwin
es fehlt vor dem Errorhändler das Exit Sub
Aber: Wenn du lesen würdest hättest du das mühelos in:
Geschrieben am: 06.03.2022 22:54:54
in Zeile 4 entdeckt
Gruß Uwe
anderer Ansatz
07.03.2022 14:33:01
Rudi
Hallo,
ich würde den Suchbereich in ein Array schreiben und per Schleife durchsuchen. Dauert ca. 0,02 Sekunden.

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim TB As Worksheet, TTXT As String
Dim Anz As Integer, JaNein As Variant, Arr, i As Integer
Dim vntTmp, sMatch As String
Dim lR As Long, lC As Long
If KeyCode = 13 Then
Set TB = Sheets("Schauspieler")
vntTmp = TB.Range("A1:IZ300")
With TextBox1
If .Text  "" Then
sMatch = "*" & LCase(.Text) & "*"
For lR = 1 To UBound(vntTmp)
For lC = 1 To UBound(vntTmp, 2)
If LCase(vntTmp(lR, lC)) Like sMatch Then
TTXT = TTXT & ";" & Cells(lR, lC).Address
Anz = Anz + 1
End If
Next
Next
If Len(TTXT) Then
Arr = Split(Mid(TTXT, 2), ";") 'Array zum Anspringen
For i = 1 To Anz
JaNein = MsgBox(Anz & "x gefunden in:" & vbLf & Arr(i - 1) & vbLf & vbLf _
, vbYesNo, "Zum Treffer " & i & " / " & Anz & " hinspringen?   J / N")
If JaNein = vbYes Then
Application.Goto TB.Range(Arr(i - 1))
Else
'            Exit For
End If
Next
Else
MsgBox "Kein Fund"
End If
End If
End With
End If
End Sub
Gruß
Rudi
Habe den Übeltäter gefunden!!!
07.03.2022 15:14:17
oraculix
Danke werde ich ausbrobieren!
Habe den Fehler endlich gefunden!
Dieser Code löst den Fehler aus wenn ich diesen Codee deaktiviere dann geht alles wieder.
'Fügt immer ein Bild ein bei linksklick in Spalte

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Const FOLDER_PATH As String = "D:\EMDB\HTML\ExcelUserform1\"
Dim strFilename As String
Dim objCell As Range
Set objCell = Target.Cells(1, 1)
If Not Intersect(objCell, Range("A:IZ")) Is Nothing Then
strFilename = Dir$(FOLDER_PATH & objCell.Text & ".*")
If strFilename  vbNullString Then
With OLEObjects("Image1")
.Top = objCell.Top
.Left = objCell.Left + objCell.Width
.Visible = True
Set .Object.Picture = LoadPicture(Filename:=FOLDER_PATH & strFilename)
End With
Else
OLEObjects("Image1").Visible = False
End If
Else
OLEObjects("Image1").Visible = False
End If
Set objCell = Nothing
End Sub

AW: Habe den Übeltäter gefunden!!!
07.03.2022 15:22:36
Rudi
das spring natürlich bei
Application.Goto TB.Range(Arr(i - 1))
an.
Abhilfe:
Definiere in einem Modul eine Public-Variable

Public bolCODE as Boolean
Die setzt du in deiner Suchroutine am Anfang auf True (und am Ende auf False)
Im Worksheet_SelectionChange am Anfang

If Not bolCODE Then
'Code
End If
Gruß
Rudi
AW: Habe den Übeltäter gefunden!!!
07.03.2022 15:31:15
oraculix
Danke für Deine Antwort!
Verstehe nur Bahnhof wo muss ich was einsetzten wohin?
Gruß
Oraculix
kleinschrittiger
07.03.2022 16:47:12
Rudi
im Kopf eines allgemeinen Moduls:

Public bolCODE as Boolean
In der UF:

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim TB As Worksheet, TTXT As String
Dim Anz As Integer, JaNein As Variant, Arr, i As Integer
Dim vntTmp, sMatch As String
Dim lR As Long, lC As Long
If KeyCode = 13 Then
bolCODE = True
Set TB = Sheets("Schauspieler")
vntTmp = TB.Range("A1:IZ300")
With TextBox1
If .Text  "" Then
sMatch = "*" & LCase(.Text) & "*"
For lR = 1 To UBound(vntTmp)
For lC = 1 To UBound(vntTmp, 2)
If LCase(vntTmp(lR, lC)) Like sMatch Then
TTXT = TTXT & ";" & Cells(lR, lC).Address
Anz = Anz + 1
End If
Next
Next
If Len(TTXT) Then
Arr = Split(Mid(TTXT, 2), ";") 'Array zum Anspringen
For i = 1 To Anz
JaNein = MsgBox(Anz & "x gefunden in:" & vbLf & Arr(i - 1) & vbLf & vbLf _
, vbYesNo, "Zum Treffer " & i & " / " & Anz & " hinspringen?   J / N")
If JaNein = vbYes Then
Application.Goto TB.Range(Arr(i - 1))
Else
'            Exit For
End If
Next
Else
MsgBox "Kein Fund"
End If
End If
End With
End If
bolCODE = False
End Sub
im Modul des Tabellenblatts:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not bolCODE Then
'dein Code
End If
End Sub
Gruß
Rudi
AW: kleinschrittiger
07.03.2022 17:28:56
oraculix
Danke für Deine Mühe !
Es bleibt beim einfrieren wenn ich es so mache wie gerade gepostet hast.
Gruß
Oraculix
AW: Neuer Code von Rudi Maintaire funktioniert
07.03.2022 16:13:40
Rudi
Vielen Dank für Deine VBA Code !
Habe ihn gerade eingefügt und funktioniert viel besser als der Alte Code!
Löst aber das Problem mit dem anderen VBA Code nicht
Diesen habe ich jetzt deaktiviert
'Fügt immer ein Bild ein bei linksklick in Spalte

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Const FOLDER_PATH As String = "D:\EMDB\HTML\ExcelUserform1\" '"D:\EMDB\HTML\ExcelCovers\"
Dim strFilename As String
Dim objCell As Range
Set objCell = Target.Cells(1, 1)
If Not Intersect(objCell, Range("A:IZ")) Is Nothing Then
strFilename = Dir$(FOLDER_PATH & objCell.Text & ".*")
If strFilename  vbNullString Then
With OLEObjects("Image1")
.Top = objCell.Top
.Left = objCell.Left + objCell.Width
.Visible = True
Set .Object.Picture = LoadPicture(Filename:=FOLDER_PATH & strFilename)
End With
Else
OLEObjects("Image1").Visible = False
End If
Else
OLEObjects("Image1").Visible = False
End If
Set objCell = Nothing
End Sub
Gruß
Oraculix

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige