Fehler im Code verursacht Doppelte
Tim
ich kämpfe mit einem Code (s.u.) der eigentlich nur folgendes machen soll (der ganze Rest betrifft Bilder, die hier nicht relevant aber im gleichen Code enthalten sind):
Wird ein Begriff in E2 eingegeben, soll dieser in einem Logfile gespeichert werden.
Das Logfile soll nach User (Environ) getrennt in einem bestimmten Ordner gespeichert werden.
Das klappte bislang gut.
Nun habe ich jedoch auf dem gleichen Blatt einige Steuerelemente eingefügt, die zwar beim Anklicken keinerlei Effekt auf E2 haben, offenbar aber dazu führen, dass der gerade befindliche Eintrag in E2 erneut in meinem Logfile gelistet wird - das führt dazu, dass ich jedes Mal, wenn diese Elemente angeklickt werden einen extra Logfile-Eintrag erhalte.
Kann mir jemand sagen, wie ich es einschränke, dass wirklich nur bei Änderung des Wertes in E2 ein neuer Logfile-Eintrag entsteht ?
Eine Alternative wäre auch, als Auslöser das Makro "AAA" aus Auslöser zu werten, da nur Einträge in E2 immer damit bestätigt werden müssen.
Aktueller Code - mit dem Verweis auf E2 im Change und im SelectionChange Sub:
Option Explicit
Const imagePath As String = "C:\Users\Notebook\Desktop\My Documents\Bilder\"
'Image saving location
Const MaxWidth As Long = 412 'Maximum width for images
Const MaxHeight As Long = 259 'Maximum height for images
Const PosLeft As Long = 551 'Image location from left
Const PosTop As Long = 137 'Image location from top
Private objImg As Object
Dim mstrOld As String
Dim RaBereich As Range
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strDatei As String, strText As String
Dim intFile As Integer, rng As Range
Const strDELIM As String = "|"
intFile = FreeFile
strDatei = "C:\Users\Notebook\Desktop\My Documents\SearchLogs\" & Environ("USERNAME") & ".txt" _
If MakeSureDirectoryPathExists(strDatei) 0 Then
Open strDatei For Append As #intFile
If LOF(intFile) = 0 Then
strText = "Entered Search Terms:"
Print #intFile, strText
End If
If Range("E2") mstrOld Then
strText = _
Range("E2")
Print #intFile, strText
End If
Close #intFile
Else
MsgBox "No search log saved as location not found !", vbExclamation, "Notification"
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim dblWidth As Double, dblHeight As Double
Dim strFile As String
Set RaBereich = Intersect(Range("E2"), Range(Target.Address))
If Not RaBereich Is Nothing Then
mstrOld = Range("E2")
End If
If Not objImg Is Nothing Then objImg.Visible = False
DoEvents
If Target.Column = 3 And Target.Count = 1 Then
If Target "" Then
strFile = imagePath & IIf(Right(imagePath, 1) "\", "\", "") & Target.Value & ".jpg"
strFile = Replace(Replace(strFile, vbLf, ""), vbCrLf, "")
If Dir(strFile) "" Then
On Error Resume Next
If objImg Is Nothing Then Set objImg = Me.OLEObjects("imageContainer")
On Error GoTo 0
If objImg Is Nothing Then createImageContainer
With objImg
.Object.AutoSize = True
.Object.Picture = LoadPicture(strFile)
.Top = ActiveWindow.VisibleRange.Top + PosTop
.Left = PosLeft
If .Height > MaxHeight Or .Width > MaxWidth Then
.Object.AutoSize = False
dblWidth = MaxWidth / .Width
dblHeight = MaxHeight / .Height
If dblWidth Tim