Forum: SAP PLM Thema: Excel-VBA als INPLACE im SAP zur ￜￜnderung von AutoCAD-Zeichnungen

Nur autorisierte Mitglieder (Administrator, Moderator) oder das Mitglied, welches den Beitrag erstellt haben, können diesen editieren. (Nur registrierte Benutzer können Beiträge editieren) HINWEIS: Nur autorisierte Mitglieder können Beiträge löschen!
Löschen? Um diesen Beitrag zu löschen, markieren Sie bitte dieses Kästchen. HINWEIS: Wenn Sie diesen Beitrag löschen, wird das gesamte Thema gelöscht, da es sich hier um den ersten Beitrag in diesem Thema handelt. Smilies in diesem Beitrag deaktivieren.
Ihr Benutzername:
Ihr Kennwort:	Kennwort vergessen?
Attachment:	Dateien uploaden  <?>   Dateien verwalten  <?>
Grafik für den Beitrag:
Zu editierender Beitrag: Fachbegriff URL Email Fett Kursiv Durchgestr. Liste * Bild Zitat Code *HTML ist AUS *UBB-Code ist AN Smilies Legende Netiquette	Original erstellt von: Christian M aus H am 11-03-2015 03:34 PM Hallo, ich habe folgendes Problem: Wir haben ein Fertigstellungsgrad-Tool im SAP aufgebaut, in dem Räume mit Soll- und Ist-Prozentwerten bewertet werden können. Zur optischen Aufbereitung der Daten verwenden wir AutoCAD-Zeichnungen mit Layern für die Farben und Blöcken für die Prozent-Angaben (Soll/Ist) Ich habe jetzt in Excel ein Programm erstellt, welches diese Daten von SAP zur Verfügung gestellt bekommt und dann AutoCAD startet, die Zeichnungen lädt und automatisch die Einfärbung der Layer und Beschriftung der Blöcke vornimmt. Zur Zeit funktioniert dieses Programm als Inplace-Anwendung im SAP im manuellen Modus (d.h.) SAP lädt die Excel-Datei und der Anwender startet das Makro per Schaltfäche. Diese funktioniert auch (mit ein paar künstlichen Pausen und MsgBox aufrufen im Makro damit SAP hinterher kommt). Wenn ich allerdings das Makro automatisch starten möchte ohne weitere Beeinflussung durch den User, gibt es einen Abap Laufzeitfehler im SAP. Fehler-Kurztext: Zugriff über 'NULL' Objektreferenz nicht möglich. Ich habe folgenden Code eingebaut, den ich durch entfernen von 'SPERRE', aktiviere DieseArbeitsmappe: Private Sub Workbook_Open()   'SPERRE' Application.OnKey "{ESC}", ""  ' ESC-Taste aus   'SPERRE' OpnAcad                        ' Startet das Hauptprogramm End Sub Und im Hauptprogramm auch: 'SPERRE'ThisWorkbook.Close  Ansonsten sind die Programme identisch. Das hier ist das Programm: Option Explicit 'Globale Variablendeklaration Public Graphics As AcadApplication                                          ' AutoCAD als solches Public Thisdrawing As AcadDocument                                          ' das aktuelle Dokument in AutoCAD Public AcadVersion, AcadProgrammPfad As String                              ' Speichert die Version der Acad-Anwendung Public WBErgebnis As Workbook                                              ' Variable für die Ergebnis-Datei Public WSDaten, WSFehler As Worksheet                                      ' Variablen für die Reiter SAP-Uebergabe und die Fehler-Seiten in der Ergebnis-Datei 'Public Menu As UserForm                                                    ' Status-Fenster Public Dateipfad, Dateiname As String                                      ' Speichert Dateipfad und -name Public Bezeichner As String                                                ' Speichert die Örtlichkeit-Art Public User As String                                                      ' speichert Nutzerkennung Public Layer_Raum, Layer_Sektion, Layer_Raumbereich As String              ' Ja, falls benutzt werden soll, sonst leer oder nein Public Block_Raum, Block_Sektion, Block_Raumbereich As String              ' Ja, falls benutzt werden soll, sonst leer oder nein Public Fehler_Zeile As Long                                                ' Zeile, in der ein Fehler auftritt Public Fehler_Anzahl, Fehler As Long                                        ' Gesamtfehlerzahl, Zähler Public Gefunden As Boolean                                                  ' indiziert gefundenen Fehler 'Hier beginnt das eigentliche Hauptprogramm Public Sub OpnAcad()     ' Deklaration der örtlichen Variablen     Dim obj_ACAD_app As AcadDocument                                        ' Ganze Acad-DWG-Zeichnung     Dim objLayer As AcadLayer                                              ' Variable für Layer     Dim strDrawing As String                                                ' Zeichnungsname     Dim Z As Integer                                                        ' Zeilenzähler     Dim S As Integer                                                        ' Spaltenzähler     Dim Spalte As Integer                                                  ' Spalte, in der Raum, Sektion und Raumbereich stehen     Dim i As Long                                                          ' allgemeine Zählvariable     Dim name As String                                                      '         User = Application.UserName                                            ' Bestimmt die UV-Nummer     Status "", "Starte aktuelle AutoCAD-Version für", User, ""              ' Füllt Userform mit der Statusanzeige     On Error Resume Next                                                    ' Wenn Fehler auftritt, nächste Befehlszeile nehmen     Set Graphics = GetObject(, "AutoCAD.Application")                      ' speichert in Graphics die Autocad-Anwendung     If Err.Description > vbNullString Then                                  ' Falls fehler auftritt (keine Autocad geladen)         Err.Clear                                                          ' Fehler löschen         On Error GoTo kein_Acad         Set Graphics = CreateObject("AutoCAD.Application")                  ' AutoCAD Starten     End If     Graphics.Visible = True                                                ' Autocad anzeigen         AcadVersion = Graphics.FullName                                        ' Speichert den Dateipfad und vollen Namen des Programms     AcadProgrammPfad = Left(AcadVersion, Len(AcadVersion) - Len("acad.exe"))     Status "Initialisiere AutoCAD-Version ", AcadVersion, "für", User      ' Füllt Userform mit der Statusanzeige         Z = 11                                                                  ' Setzt Z auf die erste Zeile mit einem Dateinamen     Set WSDaten = ThisWorkbook.Worksheets("SAP_Uebergabe")         Dateiname = WSDaten.Cells(2, 14).Value & WSDaten.Cells(3, 14).Value    ' Dateiname der Ergebnisdatei         ThisWorkbook.Activate     '    Application.Wait Now + TimeSerial(0, 0, 10)                            ' = wartet 10 Sekunden '    MsgBox (".")         Workbooks.Open (Dateiname)                                              ' Öffnet die Ergebnisdatei         Application.Wait Now + TimeSerial(0, 0, 10)                            ' = wartet 10 Sekunden     MsgBox ("Bitte bestätigen!")         Set WBErgebnis = ActiveWorkbook                                        ' Belegt Ergebnis-Workbook mit dem neuen Dokument             ThisWorkbook.Activate                                                  ' Diese Datei aktivieren         ' Hier werden die Seiten in der Ergebnisdatei geräumt     WBErgebnis.Worksheets("Fehlerliste_Raum").Range("3:100000").Delete Shift:=xlUp          'Zeile 3 bis 100.000 (sollte reichen)     WBErgebnis.Worksheets("Fehlerliste_Sektion").Range("3:100000").Delete Shift:=xlUp     WBErgebnis.Worksheets("Fehlerliste_Raumbereich").Range("3:100000").Delete Shift:=xlUp         Do                                                                      ' Schleife über alle Zeichnungen               Layer_Raum = WSDaten.Cells(Z, 3).Value                      ' Soll Layer im Raum gefärbt werden ?, bei "ja": ja, sonst: nein             Layer_Sektion = WSDaten.Cells(Z, 4).Value                      ' analog Sektion         Layer_Raumbereich = WSDaten.Cells(Z, 5).Value                      ' analog Raumbereich               Block_Raum = WSDaten.Cells(Z, 6).Value                      ' Soll Block im Raum beschriftet werden ?, bei "ja": ja, sonst: nein             Block_Sektion = WSDaten.Cells(Z, 7).Value                      ' analog Sektion         Block_Raumbereich = WSDaten.Cells(Z, 8).Value                      ' analog Raumbereich                       strDrawing = WSDaten.Cells(Z, 1).Value                      ' Zeichnungspfad und Name             Status "Lade AutoCAD-Zeichnung ...", Datei(strDrawing), "", ""      ' Status ausgabe ("Datei" zieht den Dateinamen aus dem Gesamtpfad) (s.u.)                 On Error GoTo weiter1         If strDrawing <> "" Then                                            ' Keine leeren Dateinamen öffnen             Graphics.Documents.Open (strDrawing)                            ' Öffnet Datei                     Set Thisdrawing = Graphics.ActiveDocument                      ' Zieht die aktuelle Zeichnung heran             With WSDaten                                                    ' Der Block "Datum" muss in der Zeichnung vorhanden sein                 Datum Day(.Cells(4, 1).Value), _                     Month(.Cells(4, 1).Value), _                     Year(.Cells(4, 1).Value)                              ' Ruft die Prozedur zum einsetzen des Datums in die Zeichnung auf             End With                         ' Nachfolgend werden der Reihe nach die mit "ja" gekennzeichneten Felder abgearbeitet             ' Zuerst die Layer, die gefärbt werden,             ' Danach die Blöcke, die beschriftet werden.             ' An die Prozedur übergeben wird jeweils die Spalte, in der der Ort steht             If Layer_Raum = "ja" Then                                      ' Ein kleingeschriebenes "ja" in der Variable                 Bezeichner = "Raum"                                        ' Dann handelt es sich hier um einen Raum-Code                 Set WSFehler = WBErgebnis.Worksheets("Fehlerliste_Raum")    ' Speicher für den Reiter in der Ergebnis-Datei                 Faerben (9)                                                ' Prozeduraufruf                 Set WSFehler = Nothing                                      ' Speicherfreigabe             End If                         If Layer_Sektion = "ja" Then                                    ' hier analog                 Bezeichner = "Sektion"                 Set WSFehler = WBErgebnis.Worksheets("Fehlerliste_Sektion")                 Faerben (12)                 Set WSFehler = Nothing             End If                         If Layer_Raumbereich = "ja" Then                                ' hier analog                 Bezeichner = "Raumbereich"                 Set WSFehler = WBErgebnis.Worksheets("Fehlerliste_Raumbereich")                 Faerben (15)                 Set WSFehler = Nothing             End If                         ' Jetzt die Blöcke             If Block_Raum = "ja" Then                                      ' wieder analog                 Bezeichner = "Raum"                 Set WSFehler = WBErgebnis.Worksheets("Fehlerliste_Raum")                 Block (9)                 Set WSFehler = Nothing             End If                         If Block_Sektion = "ja" Then                 Bezeichner = "Sektion"                 Set WSFehler = WBErgebnis.Worksheets("Fehlerliste_Sektion")                 Block (12)                 Set WSFehler = Nothing             End If                         If Block_Raumbereich = "ja" Then                 Bezeichner = "Raumbereich"                 Set WSFehler = WBErgebnis.Worksheets("Fehlerliste_Raumbereich")                 Block (15)                 Set WSFehler = Nothing             End If         End If         Z = Z + 2                                                          ' Zwei Zeilen tiefer steht eventuell die nächste Datei weiter1:         Err.Clear                                                          ' Fehler löschen und weiter     Loop Until strDrawing = "SPALTENENDE"                                  ' Bis die Datei "SPALTENENDE" heißt         Set WSDaten = Nothing                                                  ' Freigeben des Speichers     Set WBErgebnis = Nothing                                                ' Freigeben des Speichers 'SPERRE'ThisWorkbook.Close                                                    ' Dieser Befehl darf nur bei der Original-Live-Datei im SAP gesetzt sein         Status "", "AutoCAD Bearbeitung beendet", "Sie können die Zeichnungen jetzt speichern und drucken", "" ' Füllt Userform mit der Statusanzeige       MS_Form.CB_Beenden.Visible = True                                      ' Beendet die Status-Anzeige     Exit Sub                                                                ' Beendet das Hauptmakro '------- Fehlerauswertung ------ kein_Acad:     MsgBox ("Sie haben kein AutoCAD, bitte wenden Sie sich an die IT")      ' Meldung: Kein ACAD     Exit Sub                                                                ' Auch Ende End Sub ' Die nachfolgenden Prozeduren und Funktionen werden von dem Hauptprogramm wiederholt aufgerufen und sind daher aus dem eigentlichen Programmcode extrahiert worden. ' Die Prozedur "Faerben" färbt die sogenannten Layer in einer AutoCAD-Zeichnung mit vorgegebenen Farbwerten, jeh nach Prozentzahl ' Als Parameter wird die Spalte übergeben, in der der Layername gespeichert ist Public Sub Faerben(ByVal Spalte As Integer)                                ' In Spalte steht die Spaltennummer vom Reiter SAP-Uebergabe (Raum, Sektion, RB)     ' Deklaration der örtlichen Variablen     Dim obj_ACAD_app As Object                                              ' Applikation     Dim objLayer As AcadLayer                                              ' Variable für Layer     Dim Raum As String                                                      ' Speicher für Raumcode     Dim Farbe As Double                                                    ' Speicher für Farbe (als Prozentwert)     Dim Ist, Soll As Double                                                ' Speicher für den Ist- und Soll-Wert     Dim i As Long                                                          ' Zähler         Status "Einfärbung aller Räume", "mit den aktuellen IST-Prozentwerten ...", "", ""         Set obj_ACAD_app = GetObject(, "AutoCAD.application")                  ' Zieht die aktive AutoCAD Application an     If Err.Number <> 0 Then                                                ' Falls ein Fehler aufgetreten ist....         MsgBox "AutoCAD nicht gefunden"                                    ' Abbruch mit Meldung         Exit Sub     End If         Set Thisdrawing = obj_ACAD_app.ActiveDocument                          ' Zieht die aktive Zeichnung heran         i = 10                                                                  ' in Zeile 10 beginnen die Daten aus SAP '    Fehler_Anzahl = 1     Do                                                                      ' Schleife über alle Layer der Zeichnung (?)         Raum = WSDaten.Cells(i, Spalte).Value                              ' Raumcode aus Excel-Reiter         If Raum = "SPALTENENDE" Then Exit Do                                ' Kriterium zum Abbruch         Farbe = WSDaten.Cells(i, Spalte + 1).Value                          ' Farbe (Prozent) aus Excel-Reiter         Soll = WSDaten.Cells(i, Spalte + 2).Value                          ' Soll aus Excel-Reiter                 If Layer_Sektion = "ja" Then Raum = "Kolli " & Raum                ' Sonderfall für F125                 Status "Einfärbung aller Räume", "mit den aktuellen IST-Prozentwerten ...", Raum, Format(Farbe, "0%")                 On Error Resume Next         Set objLayer = Thisdrawing.Layers(Raum)                            ' Reserviert Speicher für den aktuellen Raum-Layer         If Err.Number <> 0 Then                                            ' Falls ein Fehler aufgetreten sein sollte             Fehler = WSFehler.Cells(Rows.Count, 2).End(xlUp).Row + 1        ' Ausgabe in der Ergebnis-Datei             WSFehler.Cells(Fehler, 2).Value = Raum             WSFehler.Cells(Fehler, 3).Value = "nicht in Zeichnung"             WSFehler.Cells(Fehler, 4).Value = Thisdrawing.name             GoTo WEITER         End If         If Len(Raum) >= 1 Then                                              ' Nur sinnvolle Räume nehmen ( alter Code )             Select Case Round(Farbe, 4)                                    ' Prozentwerte auf 4 Stellen runden und auswählen                 Case 0:                objLayer.Color = 9                  ' Hellgrau im AutoCAD                 Case 0.005 To 0.245:    objLayer.Color = 8                  ' Dunkelgrau im AutoCAD                 Case 0.2451 To 0.495:  objLayer.Color = 30                ' Orange im AutoCAD                 Case 0.4951 To 0.745:  objLayer.Color = 40                ' Gelb im AutoCAD                 Case 0.7451 To 0.945:  objLayer.Color = 2                  ' Hellgelb im AutoCAD                 Case 0.9451 To 0.99999: objLayer.Color = 60                ' Hellgrün im AutoCAD                 Case 1:                objLayer.Color = 3                  ' Dunkelgrün im AutoCAD             End Select             Fehler = WSFehler.Cells(Rows.Count, 5).End(xlUp).Row + 1        ' Ausgabe in der Eregebnis-Datei             WSFehler.Cells(Fehler, 5).Value = Raum             WSFehler.Cells(Fehler, 6).Value = Format(Round(Farbe, 2), "0%")             WSFehler.Cells(Fehler, 7).Value = Thisdrawing.name         End If WEITER:         i = i + 1                                                          ' nächster Raum         Set objLayer = Nothing                                              ' Speicher für Layer wieder freigeben     Loop Until Raum = "SPALTENENDE" Or Raum = "Kolli "                      ' Bis zum SPALTENENDE neuzeichnen:     Status "", "Einfäbung der Räume abgeschlossen", "", ""         Thisdrawing.Regen (acAllViewports)                                      ' Zeichnung in AutoCAD auffrischen         Status "", "Einfärbung der Räume abgeschlossen", "Zeichnung regeneriert", ""         Set Thisdrawing = Nothing                                              ' Speicher freigeben     Set objLayer = Nothing                                                  ' Speicher freigeben     Set obj_ACAD_app = Nothing                                              ' Speicher freigeben End Sub       ' Die Prozedur "Block" trägt in einer AutoCad-Zeichnung in sogenannten Blöcken neue Beschriftungen ein (IST- und SOLL-Prozentwerte) ' Als Parameter wird die Spalte übergeben, in der der Blockname gespeichert ist Private Sub Block(ByVal Spalte As Integer)     ' Deklaration der örtlichen Variablen     Dim obj_ACAD_app As Object                                              ' Speicher für AutoCAD     Dim Entity As AcadEntity                                                ' Speicher für ein Element     Dim Blockdef As AcadBlock                                              ' Speicher für einen Block     Dim Text As AcadText                                                    ' Speicher für Text     Dim Mtext As AcadMText                                                  ' Speicher für MText         Dim Ist, Soll As Double     Dim i As Integer     Dim Raum, Ist_Text, Soll_Text As String                                ' Speicher für Raumcode         On Error Resume Next                                                    ' Bei Fehler Anweisung überspringen     Set obj_ACAD_app = GetObject(, "AutoCAD.application")                  ' Die AutoCAD-Anwendung als solches suchen und Speicher reservieren     If Err.Number <> 0 Then                                                ' Fehlermeldung jeglicher Art         MsgBox "AutoCAD nicht gefunden"                                    ' Wird ausgegeben als kein AutoCAD     End If         Set Thisdrawing = obj_ACAD_app.ActiveDocument                          ' aktive Zeichnung auswählen         i = 10                                                                  ' Daten beginnen in Spalte 10     Do         Ist_Text = WSDaten.Cells(6, Spalte).Value         Soll_Text = WSDaten.Cells(7, Spalte).Value             Raum = WSDaten.Cells(i, Spalte).Value                              ' Raumcode aus Excel-Reiter         If Raum = "SPALTENENDE" Then Exit Do                                ' Ende der Ausgabe         Ist = WSDaten.Cells(i, Spalte + 1).Value                            ' Farbe (Prozent) aus Excel-Reiter         Soll = WSDaten.Cells(i, Spalte + 2).Value                          ' Soll aus Excel-Reiter                 Status "Beschriftung aller Räume mit Prozentwerten ...", Raum, "Ist: " & Format(Ist, "0%"), "Soll: " & Format(Soll, "0%")                 If Right(Ist_Text, 2) = "Nr" And Bezeichner = "Raum" Then Ist_Text = Left(Ist_Text, Len(Ist_Text) - 2) & Raum         If Right(Soll_Text, 2) = "Nr" And Bezeichner = "Raum" Then Soll_Text = Left(Soll_Text, Len(Soll_Text) - 2) & Raum             If Block_Sektion = "ja" Then Raum = "Kolli " & Raum                ' Sonderfall bei F125         Set Blockdef = Thisdrawing.Blocks.Item(Raum)                        ' Setzt Blockdef auf diesen Block an             Gefunden = False                                                    ' Noch kein Element gefunden         For Each Entity In Blockdef                                        ' Durchsuche alle Elemente in den Blöcken             Select Case LCase(Entity.ObjectName)                            ' Umwandlung der Objektnamen in Kleinbuchstaben             Case "acdbmtext"                                                ' Hinweis auf Blocknamen                 Set Mtext = Entity                 If InStr(0, Mtext.TextString, Len(Raum)) = Raum Then        ' Sucht im Text des Blocknamens nach dem Raumcode in exakter Länge                     Select Case Bezeichner                     Case "Raum":                         Mtext.TextString = Raum & ": " & Format(Ist, "0%")                                          '01B05: 90%                     Case "Sektion":                         Mtext.TextString = Replace(Raum, "Kolli", "Sektion") & " Ist: " & Format(Ist, "0%")        'Sektion 015 Ist: 80%                     Case "Raumbereich":                         Mtext.TextString = Raum & " Soll: " & Format(Soll, "0%")                                    '01B05 Soll: 90%                         Mtext.TextString = Mtext.TextString & vbNewLine & "      " & " Ist: " & Format(Ist, "0%")  '01B05 Soll: 90%                     End Select                                                                                      '      Ist: 45%                     Gefunden = True                                        ' Ort gefunden                 End If                 Set Mtext = Nothing                                        ' Speicherfreigabe             End Select         Next Entity                 If Not Gefunden Then                                                ' Fehlerausgabe in der Ergebnis-Datei             Fehler = WSFehler.Cells(Rows.Count, 9).End(xlUp).Row + 1             WSFehler.Cells(Fehler, 9).Value = Raum             WSFehler.Cells(Fehler, 10).Value = "nicht in Zeichnung"             WSFehler.Cells(Fehler, 11).Value = Thisdrawing.name         Else             Fehler = WSFehler.Cells(Rows.Count, 12).End(xlUp).Row + 1      ' Oder eben den erfolgreichen Übertrag             WSFehler.Cells(Fehler, 12).Value = Raum             WSFehler.Cells(Fehler, 13).Value = Format(Round(Ist, 2), "0%")             WSFehler.Cells(Fehler, 14).Value = Format(Round(Soll, 2), "0%")             WSFehler.Cells(Fehler, 15).Value = Thisdrawing.name         End If                 If Block_Sektion = "ja" Then                                        ' Bei Sektionsdarstellung brauchen wir noch einen zweiten Block             Raum = WSDaten.Cells(i, Spalte).Value                          ' Raumcode aus Excel-Reiter                         Raum = "Sek-" & Raum                                            ' Dieser heißt "Sek-XXX" (zumindest bei F125)                         Set Blockdef = Thisdrawing.Blocks.Item(Raum)                    ' Setzt Blockdef auf den Raum an             Gefunden = False                                                ' Noch kein Ort gefunden             For Each Entity In Blockdef                                    ' Durchsuche alle Elemente in den Blöcken                 Select Case LCase(Entity.ObjectName)                        ' Umwandlung der Objektnamen in Kleinbuchstaben                 Case "acdbmtext"                                            ' Hinweis auf Blocknamen ...(?)                     Set Mtext = Entity                                      ' Richtet einen Speicher für den Text ein                     If InStr(0, Mtext.TextString, Len(Raum)) = Raum Then    ' Sucht im Text des Blocknamens nach dem Raumcode in exakter Länge                         Mtext.TextString = Replace(Raum, "Sek-", "Sektion ") & " Soll:" & Format(Soll, "0%")          'Sektion 015 Ist: 80%                     End If                     Gefunden = True                                        ' Text-Block gefunden                     Set Mtext = Nothing                                    ' Speicherfreigabe                 End Select             Next Entity         End If               Set Entity = Nothing                                                ' Speicherfreigabe         Set Blockdef = Nothing                                              ' Speicherfreigabe         i = i + 1     Loop Until Raum = "SPALTENENDE" Or Raum = ""                            ' Abbruchkriterium         Set obj_ACAD_app = Nothing                                              ' Speicherfreigabe     Set Entity = Nothing                                                    ' Speicherfreigabe     Set Blockdef = Nothing                                                  ' Speicherfreigabe         Thisdrawing.Regen (acAllViewports)                                      ' Zeichnung in AutoCAD auffrischen End Sub ' DIe Prozedur "Datum" beschreibt in einer AutoCAD-Zeichnung den Block "Datum" mit dem übergebenen Datum in der Form    Stand: XX.XX.XXXX Private Sub Datum(ByVal Tag, Monat, Jahr As String)     ' Deklaration der örtlichen Variablen     Dim obj_ACAD_app As Object                                              ' Speicher für AutoCAD     Dim Blockdef As AcadBlock                                              ' Speicher für einen Block     Dim Entity As AcadEntity                                                ' Speicher für ein Element     Dim Mtext As AcadMText                                                  ' Speicher für MText         On Error Resume Next                                                    ' Bei Fehler Anweisung überspringen     Set obj_ACAD_app = GetObject(, "AutoCAD.application")                  ' Die AutoCAD-Anwendung als solches suchen und Speicher reservieren     If Err.Number <> 0 Then                                                ' Fehlermeldung jeglicher Art         MsgBox "AutoCAD nicht gefunden"                                    ' Wird ausgegeben als kein AutoCAD     End If         Set Thisdrawing = obj_ACAD_app.ActiveDocument                          ' aktive Zeichnung auswählen         On Error GoTo kein_Datum                                                ' Falls der Block nicht vorhanden ist gehe zu der Sprungmarke     Set Blockdef = Thisdrawing.Blocks.Item("Datum")                        ' Setzt Blockdef auf den Block "Datum" an         For Each Entity In Blockdef                                            ' Durchsuche alle Elemente in den Blöcken         Select Case LCase(Entity.ObjectName)                                ' Umwandlung der Objektnamen in Kleinbuchstaben         Case "acdbmtext"                                                    ' Hinweis auf Blocknamen             Set Mtext = Entity             Mtext.TextString = ThisWorkbook.Worksheets("SAP_Uebergabe").Cells(2, 1).Value             Set Mtext = Nothing                                            ' Speicherfreigabe         End Select     Next Entity kein_Datum:         Set Entity = Nothing                                                    ' Speicherfreigabe     Set Blockdef = Nothing                                                  ' Speicherfreigabe     Set obj_ACAD_app = Nothing                                              ' Speicherfreigabe         Thisdrawing.Regen (acAllViewports)                                      ' Zeichnung in AutoCAD auffrischen End Sub ' Die Prozedur "Status" gibt eine Userform mit 4 Textfeldern aus, in der der aktuelle Bearbeitungsstand ausgegeben wird Sub Status(ByVal Text1, Text2, Text3, Text4)     MS_Form.Label1.Caption = Text1                                          ' Texte der Userform belegen mit übergebenen Parametern     MS_Form.Label2.Caption = Text2     MS_Form.Label3.Caption = Text3     MS_Form.Label4.Caption = Text4     MS_Form.Show                                                            ' Userform anzeigen     MS_Form.Repaint                                                        ' Userform neuzeichnen End Sub ' Die Funktion "Datei" liefert aus dem übergebenen Parameter, dere einen Dateipfad darstellen muss, den Dateinamen Function Datei(ByVal pfad)     ' Deklaration der örtlichen Variablen     Dim temp As Variant         Dateiname = ""                                                          ' Funktionsergebnis zunächst leer     temp = Split(pfad, "\")                                                ' Splittet den übergebenen Pfad in ein Array getrennt durch "\"     On Error Resume Next                                                    ' Falls kein Dateiname übergeben wurde     Datei = temp(UBound(temp))                                              ' Das letzte Feld im Array ist der Dateiname End Function Ich weiß, daß es sich hierbei um eine sehr komplexe Fragestellung handelt, aber vielleicht habe ich ja glück und jemand kennt das Problem !! 10 20 40
System-Info / Zusatztext: Bitte hier Ihre aktuelle System-Konfiguration, oder den Zusatztext für das Forum SAP PLM angeben.	Windows 7, AutoCAD 2016, SAP 7300.3.10.3296, Patch Level 10, Build 1511726

Bitte drücken Sie nicht mehrfach auf "Änderungen durchführen".

*Ist HTML- und/oder UBB-Code aktiviert, dann können Sie HTML und/oder UBB Code in Ihrem Beitrag verwenden.