Seiten: 1 2 3 4 5 6 7 8 9 10
Hallo Mike,
da bin ich bei zwei Textboxen in den Spalten verrutscht.
diese Zeilen im Code:
Code:
TextBox12 = .Cells(i, 19) 'Abnahmemenge in Box
TextBox13 = .Cells(i, 20) 'Mindestabnahme
' TextBox14 = ""
...........
TextBox12.Tag = .Cells(i, 19) 'Abnahmemenge in Box
TextBox13.Tag = .Cells(i, 20) 'Mindestabnahme
End With
so ändern:
Code:
TextBox12 = .Cells(i, 20) 'Abnahmemenge in Box
TextBox13 = .Cells(i, 21) 'Mindestabnahme
' TextBox14 = ""
...........
TextBox12.Tag = .Cells(i, 20) 'Abnahmemenge in Box
TextBox13.Tag = .Cells(i, 21) 'Mindestabnahme
End With
Hallo Atilla,
ich werde bald 50....ob es daran liegt, das ich das nicht hin bekomme? ;)
Hier der Code, mit deinen Änderungen:
Option Explicit
Private Const PICTURE_PATH = "I:\Bilder Etiketten\"
Private Const PICTURE_EXTENSION = ".jpg"
Private Sub Worksheet_Activate()
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objShape As Object
If Target.Address = "$K$6" Then
For Each objShape In Shapes
If objShape.TopLeftCell.Address = "$O14$" Then
objShape.Delete
Exit For
End If
Next
If Not IsEmpty(Target.Value) Then
If Dir$(PICTURE_PATH & Range("O6") & PICTURE_EXTENSION) = vbNullString Then
MsgBox "Kein Bild zu Materialnummer ''" & Target.Value & _
"'' gefunden.", vbExclamation, "Hinweis"
Else
Set objShape = Me.Pictures.Insert(PICTURE_PATH & _
Target.Value & PICTURE_EXTENSION)
objShape.Top = Cells(14, 15).Top
objShape.Left = Cells(14, 15).Left
End If
End If
Den Rot markierten Bereich meldet er mir als Fehler.
Lg Mike
Hallo Mike,
na, dann fehlt nicht mehr viel bis zum Ziel.
Den Teil habe ich übersehen.
Da auch:
Target.Value
mit
Range("O6")
ersetzen.
Hallo Atilla,
gestern konnte ich nicht mehr antworten.
Habe nun auch diese Änderung durchgeführt. Siehe wieder rot markiert.
Geht immer noch nicht....ich glaub, ich bin zu blöd. :)
Option Explicit
Private Const PICTURE_PATH = "I:\Bilder Etiketten\"
Private Const PICTURE_EXTENSION = ".jpg"
Private Sub Worksheet_Activate()
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objShape As Object
If Target.Address = "$K$6" Then
For Each objShape In Shapes
If objShape.TopLeftCell.Address = "$K$6" Then
objShape.Delete
Exit For
End If
Next
If Not IsEmpty(Target.Value) Then
If Dir$(PICTURE_PATH & Target.Value & PICTURE_EXTENSION) = vbNullString Then
MsgBox "Kein Bild zu Materialnummer ''" & Target.Value & _
"'' gefunden.", vbExclamation, "Hinweis"
Else
Set objShape = Me.Pictures.Insert(PICTURE_PATH & _
Range("O6") & PICTURE_EXTENSION)
objShape.Top = Cells(14, 15).Top
objShape.Left = Cells(14, 15).Left
End If
End If
Set objShape = Nothing
End If
End Sub
Und deine Code Änderung für die Mindestabnahme bekomme ich auch noch nicht hin.
Ich tüfftle da aber weiter, bis ich das verstanden habe.
Gruß Mike
Hallo!
Nur so ein Bauchgefühl:
Heißt der Pfad "I:\Bilder Etiketten\"
oder doch "I:\Bilder\Etiketten\"
Gruß, Ralf
Hallo Mike,
das was Ralf schreibt, könnte mit die Ursache sein.
Kommt den Die MSGBOX mit der Meldung: "Kein Bild ...."
oder eine andere Fehlermeldung, wie Pfad nicht gefunden.
Geht nicht ist zu dürftig.
[attachment=894]Hi Atilla,
also ein kleiner Tippfehler war wirklich drinnen....ich sollte mir eine neue Brille verpassen lassen.
Den Tippfehler habe ich beseitigt und die Bilder sind wirklich auch in diesem Pfad.
Leider geht es immer noch nicht.
Hier jetzt, hoffe ich der Fehlerfreie Code....ansonsten schaut euch gerne meine Mappe noch einmal an und probiert es vielleicht mit euren Bildern?
Code:
Option Explicit
Private Const PICTURE_PATH = "I:\Etiketten\"
Private Const PICTURE_EXTENSION = ".jpg"
Private Sub Worksheet_Activate()
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objShape As Object
If Target.Address = "$K$6" Then
For Each objShape In Shapes
If objShape.TopLeftCell.Address = "$K$6" Then
objShape.Delete
Exit For
End If
Next
If Not IsEmpty(Target.Value) Then
If Dir$(PICTURE_PATH & Target.Value & PICTURE_EXTENSION) = vbNullString Then
MsgBox "Kein Bild zu Materialnummer ''" & Target.Value & _
"'' gefunden.", vbExclamation, "Hinweis"
Else
Set objShape = Me.Pictures.Insert(PICTURE_PATH & _
Range("O6") & PICTURE_EXTENSION)
objShape.Top = Cells(14, 15).Top
objShape.Left = Cells(14, 15).Left
End If
End If
Set objShape = Nothing
End If
End Sub
[
attachment=904]
Grüße an euch und Danke
Mike
Code strukturiert dargestellt durch 3. Button von rechts im Beitragsformular: #
photo Raute_zps3ee56209.jpg
Edit:
Kopfzeile im Anhang entfernt
Moderator
Hallo Atilla,
es kommt die Meldung_ Kein Bild gefunden.
Gruß
Mike.
Hallo Atilla,
habe den Bilder Pfad jetzt noch einmal umbenannt.
Also das Bilderverzeichnis auf Platte.
Er heißt bei mir jetzt so:
"I:\Etiketten\"
Dementsprechend habe ich das natürlich auch im Code angepasst.
Hatte gedacht, das es vielleicht dann geht?
Aber der Code will nicht mit mir zusammen arbeiten. :)
Gruß
Mike
Hallo Mike,
aber das hatten wir doch schon.
Du hast doch geschrieben, dass der Bildname der Formelwert aus Zelle O6 ist.
Und diese Zeile
If Dir$(PICTURE_PATH & Target.Value & PICTURE_EXTENSION) = vbNullString Then
nimmt aber den Namen aus K6.
Das solltest Du so ändern:
If Dir$(PICTURE_PATH & Range("O6") & PICTURE_EXTENSION) = vbNullString Then
Seiten: 1 2 3 4 5 6 7 8 9 10