---

Hallo Zusammen,
ich habe hier wieder mal ein Problem auf dem Tisch, welches meine bescheidenen Fähigkeiten bei weitem übersteigt.

Ich habe für uns mit Stefans Hilfe (vielen Dank für deine Vorlage!  ) ein Makro umgeschieben, welches uns die Baugruppen als EASM-Dateien auf dem Server (unter der Artikelnummer Mechanik + Dateiname) ablegt. Bei dem Auslesen der Artikelnummer hätte ich gern abgefragt, ob die Artikelnummer mit "M" anfängt und im übrigen 8stellig ist. Hat da jemand eine Idee dazu?

Hier der Code

Dim swApp As Object
Dim ModelDoc2 As Object
Dim Part As Object
Dim Pdminfo As String
Dim ArtNrMech As String
Dim Dateiname As String
Dim Pfad As String

Sub main()

    Set swApp = CreateObject("SldWorks.Application")
    Set ModelDoc2 = swApp.ActiveDoc
   
   
    ' dann war gar kein Dokument geöffnet, wie soll da was funktionieren
    If ModelDoc2 Is Nothing Then
            MsgBox " Kein Dokument geöffnet! "
        Exit Sub
    End If
   
    ' wenn keine Assembly aktiv ist wird das Makro wieder beendet
    If (ModelDoc2.GetType <> swDocASSEMBLY) Then
            MsgBox " Nur für Baugruppen geeignet! "
        Exit Sub
    End If
   
    ' Status des PDM Systems ermitteln
    Set Part = swApp.ActiveDoc
    Pdminfo = Part.CustomInfo2("", "Status")
        If Not Pdminfo = "Freigegeben" Then
            MsgBox "Datei ist im PDM-System nicht freigegeben!"
        End
        End If
   
   
    ' Ansichten aktualisieren, wenn erforderlich
    If errors = swDocNeedsRebuildWarning Then
    AssemblyDoc.EditRebuild
    End If
   
    'Die BG isometrisch fensterfüllend in Szene setzen
    Set swApp = CreateObject("SldWorks.Application")
    Set ModelDoc2 = swApp.ActiveDoc
    Part.ShowNamedView2 "*Isometrisch", 7
    'Part.Save2 False
    Part.ViewZoomtofit2
    'Part.Save2 False
 
    'Namen der BG holen
    Dateiname = ""
    Dateiname = Part.GetTitle
   
    'Artikelnummer Mechanik holen
    Set Part = swApp.ActiveDoc
    ArtNrMech = Part.CustomInfo2("", "Artikelnummer")
    If ArtNrMech = "" Then 'HIER hätte ich gern die Abfrage erweitert nach z.B. "M9100000"
            MsgBox "Keine Artikelnummer Mechanik vergeben!"
        End
    End If
   
    'speichern unter dem beabsichtigten Netzlaufwerk
    Pfad = "P:\PRODUKTION VIDEO\Entwicklungsprojekte"
    Part.SaveAs2 Pfad + "\" + ArtNrMech + " - " + Dateiname + ".easm", 0, True, False
    MsgBox "Baugruppe wurde als " + ArtNrMech + " - " + Dateiname + ".easm gespeichert!", _
        vbInformation, "Save as EASM"
   

End Sub

------------------
Viele Grüße, THSEFA 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

If Left(ArtNrMech,1)="M" and Len(ArtNrMech)=8 Then

------------------
Dirk

[Diese Nachricht wurde von Dirk Wollborn am 26. Aug. 2009 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hab vielen Dank! Es funktionier aber leider nur zum Teil!

Wenn ich den ersten Teil benutzte, dann geht es. -> (If not Left(ArtNrMech,1)="M" Then)

Wenn ich den kompletten Code nutzen will, rennt das Makro durch und speichert. Momentan habe ich zum Testen in der Eigenschaft eine Leerzeichen drin. Nehme ich es raus, ist es genau das gleiche.

------------------
Viele Grüße, THSEFA 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

If not(Left(ArtNrMech,1)="M" and Len(ArtNrMech)=8) Then

------------------
Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Klasse! So geht´s! Hab vielen Dank!!!

------------------
Viele Grüße, THSEFA 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Trau mich gar nicht richtig zu fragen: Gibt es eine Möglichkeit, jetzt noch schnell mal in einer bestimmten Excel-Tabelle auf unserem Server vorbeizukucken, ob die ArtNrMech und der Name der BG, die dort in der Liste stehen, mit dem Eigenschften in der BG übereinstimmen?

Hintergrund ist der, das leider ein paar von uns nicht immer alle Vorgänge einhalten wollen. Dann muss es eben ein wenig "erzwungen" werden! 

------------------
Viele Grüße, THSEFA 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo THSEFA,

klar besteht die Möglichkeit, aber mit mal so schnell kann ich momentan leider nicht dienen.

So auf die schnelle - es gibt aber einige Seiten im Internet wo so etwas beschrieben ist

Dim xlTmp As Excel.Application
Set xlTmp = New Excel.Application
xlTmp.Workbooks.Open "C:\Book1.xls"
Dim xlSht As Excel.Worksheet
Set xlSht = xlTmp.Sheets(1)

...

xlTmp.Workbooks.Close
xlTmp.Quit

------------------
Dirk

[Diese Nachricht wurde von Dirk Wollborn am 26. Aug. 2009 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Liegen deine Werte in Spalten oder Zeilen vor?

------------------
Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

K-Tabelle.jpg

Hallo Dirk,
habe bis jetzt probiert, bekomme es aber nicht wirklich hin. Habe dann nochmal gesucht und einen Schnipsel gefunden, welcher zumindest meine Tabelle geöffnet hat. Diese Tabelle siehts du auf dem Bild ->

Hier der Code (das mit dem Excel-Dings mal noch auskommentiert...   )

Dim swApp As Object
Dim ModelDoc2 As Object
Dim Part As Object

Public xlApp As Object
Public wb As Object    'workbook
Public ws As Object    'worksheet

Dim Pdminfo As String
Dim ArtNrMech As String
Dim Dateiname As String
Dim Pfad As String

Sub main()

    Set swApp = CreateObject("SldWorks.Application")
    Set ModelDoc2 = swApp.ActiveDoc
   
   
    ' dann war gar kein Dokument geöffnet, wie soll da was funktionieren
    If ModelDoc2 Is Nothing Then
            MsgBox " Kein Dokument geöffnet! "
        Exit Sub
    End If
   
    ' wenn keine Assembly aktiv ist wird das Makro wieder beendet
    If (ModelDoc2.GetType <> swDocASSEMBLY) Then
            MsgBox " Nur für Baugruppen geeignet! "
        Exit Sub
    End If
   
    ' Status des PDM Systems ermitteln
    Set Part = swApp.ActiveDoc
    Pdminfo = Part.CustomInfo2("", "Status")
        If Not Pdminfo = "Freigegeben" Then
            MsgBox "Datei ist im PDM-System nicht freigegeben!"
        End
        End If
   
   
     ' Ansichten aktualisieren, wenn erforderlich
    If errors = swDocNeedsRebuildWarning Then
    AssemblyDoc.EditRebuild
    End If
   
    'Die BG isometrisch fensterfüllend in Szene setzen
    Set swApp = CreateObject("SldWorks.Application")
    Set ModelDoc2 = swApp.ActiveDoc
    Part.ShowNamedView2 "*Isometrisch", 7
    'Part.Save2 False
    Part.ViewZoomtofit2
    'Part.Save2 False
  
    'Namen der BG holen
    Dateiname = ""
    Dateiname = Part.GetTitle
   
    'Artikelnummer Mechanik holen
    Set Part = swApp.ActiveDoc
    ArtNrMech = Part.CustomInfo2("", "Artikelnummer")
    If Not (Left(ArtNrMech, 1) = "M" And Len(ArtNrMech) = 8) Then
            MsgBox "Keine gültige Artikelnummer Mechanik vergeben!"
        End
    End If
   
    'Abfrage ob BG auch in der Konstrutionstabelle gelistet ist
    'Set xlApp = CreateObject("Excel.Application")
    'xlApp.Visible = False                              ' unsichtbar
    'xlApp.UserControl = False                          ' von hier kein Zugriff auf die Excel-Datei

    'Set wb = xlApp.Workbooks.Open("P:\PRODUKTION VIDEO\Info Lager\Konstruktions- und  Artikelnummern.xls")
    'Set ws = wb.Worksheets(2) ' Excel-Zugriff
   
   
    'speichern unter dem beabsichtigten Netzlaufwerk
    Pfad = "P:\PRODUKTION VIDEO\Entwicklungsprojekte"
    Part.SaveAs2 Pfad + "\" + ArtNrMech + "_" + Dateiname + ".easm", 0, True, False
    MsgBox "Baugruppe wurde als " + ArtNrMech + "_" + Dateiname + ".easm gespeichert!", _
        vbInformation, "Save as EASM"
   

End Sub

Wenn ich hier auf meiner Excel-Tabelle bin, gehts eben nicht wirklich weiter. Es gibt dann verschiedene Ansätze, wie ich die ArtNrMech + den Dateinamen überprüfen könnte.
Ich würde es gerne so machen, das ich den Wert der ArtNrMech mir in eine leere Zelle schreibe (zB.A3) und dann diesen Wert per Makro in der Tabelle suchen lasse. Wenn gefunden, dann kurz 2 nach links gekuckt, diesen Wert ausgelesen und kopiert - Tabelle zu - SWX wieder aktiv gemacht - Wert aus der Excel-Zelle mit Dateiname verglichen...

So stell ich mir das vor.  

Morgen geht´s hier weiter. Heute fallen mir schon die Äuglein zu... 

------------------
Viele Grüße, THSEFA    

[Diese Nachricht wurde von THSEFA am 26. Aug. 2009 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Bin schon so fertig, dass ich auf Zitat statt auf edit gedrückt habe...

[Diese Nachricht wurde von THSEFA am 26. Aug. 2009 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Moin,
mit

xlapp.Range("G1").Select
variable = xlapp.ActiveCell

wird das Feld G1 ausgewählt und der Wert an eine variable übergeben.
Das ganze musst du nun eben noch in eine Schleife verpacken und G1 so verbasteln das er von G1-Gn alle Werte ausliest und vergleicht, usw.
Du kannst z.B. so hochzählen.

const Spalte = "G"
Dim Zeile
Dim Ergebnis
Dim Zähler

Zeile = 1
Ergebnis = Spalte & Zeile
For Zeile = 1 to 100
xlapp.Range("" & Ergebnis & "").Select
variable = xlapp.ActiveCell
'vergleichen
Next

Die Endbedingung (hier als Beispiel 100) kannst du dann auch wieder so verbasteln das er solange liest bis das Feld leer ist..wie das geht kann ich dir aber auf die schnelle nicht sagen. DAs ganze soll aber auch nur ein Ansatzpunkt sein, evtl. ist der Code nicht 100% richtig.

viele Grüße
Andy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Vielen Dank erst mal an meine fleißigen Helfer! 

Konnte bisher erreichen, dass die bestimmte Excel-Tabelle aufging. Mehr aber noch nicht. Muss leider erst mal das Projekt auf Eis legen, da jetzt die konstruktive Arbeit ruft... 

------------------
Viele Grüße, THSEFA 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP