Hilfe bei erweiterung Macro

[M.Wichmann]

Guten Morgen,

habe die Codes gerade noch mal getestet.

Also Andre seiner läuft, aber gibt die Nummer nicht sauber aus. In der MSG steht die Zahl und diese 2 senkrechten Striche.
und es kommt eine 2. MSG. Da ja die position Sachnummer Lieferant in der Verpackung noch mal kommt.
Bei Stefan seinem passiert garnix, man sieht nur das im hintergrund was ablüft. Kann das daran liegen das der Abruf nicht 7518 is?

Wie gesagt, ich bin eigentlich auch auf einem guten Weg das hinzubekommen. Erfordert zwar noch bissel Arbeit, aber das bekomme ich zumindest zum größten Teil alleine hin.

Wenn Ihr weitermachen wollt um das Problem zu lösen gerne, aber ich denke da das ja noch einige Arbeit von euch erfordert.
Also muss das nicht unbedingt sein.

Evtl könnt ihr später ja mal meine Codes etwas optimieren.
Wie gesagt meine Testdatei läuft, und bin jetzt dabei das in die richtige zu integrieren, da hapert es noch ein wenig.

[M.Wichmann]

Hallo,

ich habe es jetzt am laufen. Kann sein das es etwas umständlich ist, aber es erfüllt seinen Zweck.

Hier mal die Codes, evtl kann man ja was optimieren.

Daten aus Zwischenablage holen:

Code:

Sub holen()
'
' holen Makro
'

'
Sheets("Temp").Select
Range("A2").Select
   ActiveSheet.Paste
End Sub

In Temp wird dann Zeile 7 nach der Spezifischen Nummer Ausgelesen und wenn Zelle XX =1 per Sheetüberwachung das makro gestartet.  (=WENN(H7="R308616906 ";1;0)  )

Makrostart:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("J1").Value = 1 Then
Call Makro2
End If
If Range("a1").Value = 1 Then
Call Makro7509
End If
If Range("b1").Value = 1 Then
Call Makro7510
End If
If Range("c1").Value = 1 Then
Call Makro7517
End If
If Range("d1").Value = 1 Then
Call Makro7518
End If
If Range("e1").Value = 1 Then
Call Makro9063
End If
If Range("f1").Value = 1 Then
Call Makro9084
End If
If Range("k1").Value = 1 Then
Call Makro553W
End If
If Range("g1").Value = 1 Then
Call Makro671W
End If
If Range("l1").Value = 1 Then
Call Makro9054
End If
If Range("i1").Value = 1 Then
'Call Makro9054D
End If

End Sub

Das eigentliche Makro:

Code:

Sub Makro7509()
'
' Makro Makro7509
' Kopieren Daten
   Range("A2:A333").Select
   Selection.Copy
   ' Einblenden Sheet
   Sheets("7509").Visible = True
   Sheets("7509").Select
   ' Einfügen Daten
   Range("A2").Select
   ActiveSheet.Paste
   ' Bereinigen Daten
   Sheets("Temp").Select
   Application.CutCopyMode = False
   Selection.ClearContents
   ActiveWindow.SmallScroll Down:=-15
   'Ansicht zurücksetzen
   Sheets("Termineingabe").Select
   
   ' Abfrage manuelle Anpassung Daten
   If MsgBox("7509 Erkannt!Anpassungen notwendig?", vbYesNo + vbQuestion) = vbYes Then
       
      Sheets("7509").Select
       Range("A35").Select
       Exit Sub
   End If
   Sheets("7509").Visible = False
End Sub

Und das dann für jedes Teil

Momentan scheint alles zu laufen, allerdings muss ich das alles noch in der Praxis testen, ob irgendwo noch Fehler sind.

[M.Wichmann]

Zusätzlich habe ich noch in jedem Blatt eine Funktion eingebaut die mir mitteilt, das der Abruf auch im richtigen Blatt angekommen ist. Allerdings kommt die MsgBox sofort beim einfügen und die Ansicht wechselt in das Blatt bis ich bestätige. Jemand ne Idee wie ich das umgehen kann?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Range("H1").Value = 1 Then

MsgBox " 7509 wurde richtig gespeichert"
End If

End Sub

[Steffl]

Hallo,

Bei Stefan seinem passiert garnix, man sieht nur das im hintergrund was ablüft. Kann das daran liegen das der Abruf nicht 7518 is?

kommentier mal das On Error Resume Next aus im Code TextFromClipB. Dann solltest Du eine Fehlermeldung erhalten. Fahre, wenn dies geschieht über die Variablen, dann solltest Du erkennen woran es liegt.

[M.Wichmann]

Hallo, also ich habe den Code heute morgen angepasst.
Aber nix passiert. Habe sogar als errorhandler ne MsgBox eingebaut, die springt an.

Mit dem komentier meintest du das doch so oder?

Code:

Public Sub TextFromClipB()
 'Variablendeklarationen
 'Objekt, Variant, Long
 Dim oData As New DataObject, arrData, iCnt&
 'Bei Fehler gehe zu Fehlerbehandlung
 'z.B. Grafik statt text
 'On Error GoTo errorhandler
 'Daten aus der Zwischenablage holen
 oData.GetFromClipboard
 'Daten anhand Zeilenvorschub in Array splitten
 arrData = Split(oData.GetText, vbLf)
 'Schleife ueber alle Elemnte des Arrays
 For iCnt = 0 To UBound(arrData)
    'Wenn der Kennstring enthalten ist, dann
    If InStr(1, arrData(iCnt), "Sachnummer Kunde :") > 0 Then
      'Lieferantennummer extrahieren und ausgeben
'       MsgBox Replace(Replace(Replace(arrData(iCnt), "Sachnummer Kunde :", ""), "  ", ""), "|", "")
      Auto7518 Replace(Replace(Replace(arrData(iCnt), "Sachnummer Kunde :", ""), "  ", ""), "|", "")
    'Ende Wenn der Kennstring enthalten ist, dann
    End If
 'Ende Schleife ueber alle Elemnte des Arrays
 Next
errorhandler: MsgBox ("halt")
End Sub

[M.Wichmann]

Hallo noch mal.

Also das was ich gestern gebaut habe, hat heute den ersten Praxistest bestanden.

Im großen und ganzen könnte man das so lassen.

Aber für eine Sache bräuchte ich definitiv noch Hilfe. Und zwar wäre es sehr hilfreich wenn der Code, der den Text aus der Zwischenablage holt und in Temp zwischenspeichert, kontrolliert ob das wirklich ein Abruf ist und auch ob überhaupt was drin ist.

Ich habe schon versucht eure und meins zu kombinieren, werde auch weiter experimentieren. 
Aber evtl is von euch ja wer schneller^^

Mein kleiner Code zum einfügen:

Code:

Sub holen()
'
' holen Makro
'

'
Sheets("Temp").Select
Range("A2").Select
   ActiveSheet.Paste

End Sub

Der Code müsste dafür ja eigentlich nur das erste Wort kontrollieren:
                     Lieferabruf nach VDA-Norm 4905       Datum 20.06.2017
Uhrzeit 12:44               ID-Nummer: 69859              Seite          1
 +-------------------------------------------------------------------------+
Das er nur weitermacht, wenn das erste Wort Lieferabruf ist. Ansonsten Abruch und eine Rückmeldung.

[Steffl]

Hallo,

Mit dem komentier meintest du das doch so oder?

Genauso habe ich es gemeint. Aber damit Du besser sieht, wie der Code abläuft, habe ich mal ein Stop eingefügt. Excel hält den Code an dieser Position an und Du kannst mit der F8-Taste den weiteren Codeablauf sehen. Jetzt meine Frage an dich: Kommt der Code an die Stelle Auto7518?

Code:

Public Sub TextFromClipB()
  'Variablendeklarationen
  'Objekt, Variant, Long
  Dim oData As New DataObject, arrData, iCnt&
  'Bei Fehler gehe zu Fehlerbehandlung
  'z.B. Grafik statt text
  'On Error GoTo errorhandler
  'Daten aus der Zwischenablage holen
  
  
  Stop
  'jetzt mit der F8-Taste durch den Code gehen,
  'siehst Du den Grund warum nichts passiert?
  
  oData.GetFromClipboard
  'Daten anhand Zeilenvorschub in Array splitten
  arrData = Split(oData.GetText, vbLf)
  'Schleife ueber alle Elemnte des Arrays
  For iCnt = 0 To UBound(arrData)
     'Wenn der Kennstring enthalten ist, dann
     If InStr(1, arrData(iCnt), "Sachnummer Kunde :") > 0 Then
       'Lieferantennummer extrahieren und ausgeben
'       MsgBox Replace(Replace(Replace(arrData(iCnt), "Sachnummer Kunde :", ""), "  ", ""), "|", "")
       auto7518 Replace(Replace(Replace(arrData(iCnt), "Sachnummer Kunde :", ""), "  ", ""), "|", "")
     'Ende Wenn der Kennstring enthalten ist, dann
     End If
  'Ende Schleife ueber alle Elemnte des Arrays
  Next
errorhandler: MsgBox ("halt")
End Sub

[M.Wichmann]

Also wenn ich das schrittweise weiter mache, 


bewegt sich die Markierung immer in diesem Bereich, 

Code:

If InStr(1, arrData(iCnt), "Sachnummer Kunde :") > 0 Then
      'Lieferantennummer extrahieren und ausgeben
'       MsgBox Replace(Replace(Replace(arrData(iCnt), "Sachnummer Kunde :", ""), "  ", ""), "|", "")
      Auto7518 Replace(Replace(Replace(arrData(iCnt), "Sachnummer Kunde :", ""), "  ", ""), "|", "")
    'Ende Wenn der Kennstring enthalten ist, dann
    End If
 'Ende Schleife ueber alle Elemnte des Arrays
 Next

aber ohne das die Zeile Auto7518 markiert wird. Also die überspringt er.

[Steffl]

Hallo,

und ist es in deinem Originaltext auch so, das zwischen dem Wort Kunde und dem Doppelpunkt exakt ein Leerzeichen ist oder gibt es keins oder sind es zwei, drei, vier.... Leerzeichen?

[M.Wichmann]

Zwischen Kunde und : sind 5 Leerzeichen