Excel Maske zum ändern und anzeigen von Daten

[atilla]

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

[Mike4711]

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

[atilla]

Hallo Mike,

na, dann fehlt nicht mehr viel bis zum Ziel.
Den Teil habe ich übersehen.

Da auch:

Target.Value

mit

Range("O6")

ersetzen.

[Mike4711]

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

[RPP63]

Hallo!
Nur so ein Bauchgefühl:
Heißt der Pfad "I:\Bilder Etiketten\"
oder doch "I:\Bilder\Etiketten\"

Gruß, Ralf

[atilla]

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.

[Mike4711]

[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

  Mike4711-Ati-5.xlsm (Größe: 270,8 KB / Downloads: 1)

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

[Mike4711]

Hallo Atilla,

es kommt die Meldung_ Kein Bild gefunden.

Gruß

Mike.

[Mike4711]

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

[atilla]

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