[VBA] Festlegen des Namens einer .sldprt-Datei basierend auf einer Zelle in der Excel-Datei der zugehörigen Bauteilfamilie

tmauduit · 13. Februar 2017 um 08:14

Hallo ihr alle

Nach mehreren erfolglosen Versuchen beschloss ich, zu kommen und mir etwas mehr Hilfe zu holen.

Ich muss den Inhalt einer Zelle in einer Excel-Datei abrufen und ihn dann als Dateinamen definieren.

Das Ziel wäre daher:

-Stellen Sie den Inhalt der Zelle wieder her,

- Legen Sie es als Dateinamen in einem Dialogfeld fest und lassen Sie es dem Benutzer bearbeitbar, damit es interagieren kann.

- Speichern unter: - entweder in einem benutzerdefinierten Ordner,

-oder auf dem Schreibtisch, wenn es zu kompliziert ist.

Ich stelle Ihnen mein Stück Code zur Verfügung, das mit Hilfe verschiedener Tutorials/Codes erstellt wurde, die rechts und links abgerufen wurden

Dimmen swApp als Objekt

Teil als Objekt dimmen
Dim boolstatus als boolescher Wert
Dim longstatus As Long, longwarnings As Long

Sub main()

Legen Sie swApp = Application.SldWorks fest
Set Part = swApp.ActiveDoc
PartPath als Zeichenfolge dimmen
Pfadgröße so lange dimmen
Dim PathNoExtension als Zeichenfolge
Dim NewFileName als Zeichenfolge
Arbeitsmappen als Ganzzahl dimmen

PartPath = Part.GetPathName
Pfadgröße = Strings.Len(Teilpfad)
PfadNoExtension = Zeichenfolgen.Links(Teilpfad, Pfadgröße - 7)

'NewFileName = InputBox("Geben Sie den neuen Namen ein, den Sie in Excel abgerufen haben", "Speichern Sie eine Kopie", Neuer Dateiname)
'Wenn NewFileName = "" dann
NewFileName = Arbeitsmappen ("DESIGNTABLE"). WorkSheets("Sheet1"). Zellen(1, 9)

"Ende, wenn

longstatus = Teil.SaveAs2(Neuer Dateiname & ".sldprt", 0, 1, 0)
'swApp.CloseDoc PartPath ' schließt altes Dokument
Set Part = swApp.OpenDoc6(NewFileName & ".sldprt", 1, 0, "", longstatus, longwarnings)

Ende Sub

gt22 · 13. Februar 2017 um 10:41

Frage: Wie lautet der Name Ihrer Excel-Zelle?

Handelt es sich um eine Koncarenation von x Zellen?

da es sich um den Namen eines Dateiteils handeln soll

@+ ;-)

tmauduit · 13. Februar 2017 um 10:45

Ich habe den Code geändert, der effizienter ist als der aktuelle.

Sub SAVE() 'Speichern unter
Dim swApp als SldWorks.SldWorks
Dim SWmoddoc As SldWorks.ModelDoc2
CODE als Zeichenfolge dimmen
Dim nErrors so lange
Dimmen nWarnungen so lange
Legen Sie swApp = Application.SldWorks fest
Legen Sie SWmoddoc = swApp.ActiveDoc fest.

Pfadname = UCase(SWmoddoc.GetPfadname)

Wenn right(PathName, 3) = "DRW" dann
    MesgBOX = MsgBox("Makro, das nur von einem Teil oder einer Baugruppe ausgeführt werden soll", vbMsgBoxSetForeground, "Speichern unter")
    Sub beenden
    ElseIf Right(Pfadname, 3) = "PRT" dann
        DRWPath = Ersetzen(Pfadname, "PRT", "DRW")
    ElseIf Right(Pfadname, 3) = "ASM" dann
        DRWPath = Ersetzen(Pfadname, "ASM", "DRW")
Ende, wenn

FilePath = Links(Pfadname, InStrRev(Pfadname, "\"))

Dateiname = Rechts(Pfadname, Len(Pfadname) - InStrRev(Pfadname, "\"))

RET = MsgBox("Haben Sie den Namen der Riemenscheibe in Excel kopiert?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Speichern unter")

Wenn RET = vbAbbrechen, dann Ende
Tun

NewName = InputBox("Bitte geben Sie den neuen Namen an, den Sie aus Excel abgerufen haben" & vbNewLine, "Speichern", FR-Beschriftung)

Wenn StrPtr(NewName) = 0, dann
MsgBox "Vorgang abgebrochen"

Sub beenden
Ende, wenn

Do while InStr(NewName, Chr(34)) > 0 oder InStr(NewName, "\") > 0 oder InStr(NewName, "/") > 0 _
oder InStr(NewName, ":") > 0 oder InStr(NewName, "*") > 0 oder InStr(NewName, "?") > 0 oder InStr(NewName, "<") > 0 oder InStr(NewName, ">") > 0 oder InStr(NewName, "|") > 0

        NewName = InputBox("Warnung, der Name enthält mindestens eines der verbotenen Zeichen \/:*?""<>|" & vbNewLine & vbNewLine & _
        "Bitte geben Sie den neuen Namen ein: ", "Speichern unter", Neuer Name)
    Schleife

Schleife, während NewName = ""

Tun
    FilePath = InputBox("In welchem Ordner möchten Sie die Riemenscheibe speichern?", "Speichern unter", FilePath)
    Wenn StrPtr(FilePath) = 0, dann
        MsgBox "Vorgang abgebrochen"
        Sub beenden
    Ende, wenn
    Wenn Right(FilePath, 1) <> "\" dann FilePath = FilePath & "\"

    Wenn Dir$(FilePath) <> "" dann
        EXISTIERT = 1
    Ansonsten: MsgBox "Das Verzeichnis existiert nicht, bitte erstellen Sie es"
    Debug.Print Dir$(Dateipfad)
    Ende, wenn

Schleife, während EXISTS <> 1

Set swModel = swApp.ActivateDoc2(Pfadname, False, nErrors)

Wenn (SWmoddoc.GetType = swDocASSEMBLY) dann

SWmoddoc.SaveAs (DateiPfad + Neuer Code + Neuer Name + ". SLDASM")
ElseIf (SWmoddoc.GetType = swDocPART) dann

SWmoddoc.SaveAs (DateiPfad + Neuer Name + ". SLDPRT")
Ende, wenn

Ende Sub

Meine Zelle hat keinen bestimmten Namen. Es ruft einfach Informationen aus der Tabelle ab, indem Buchstaben hinzugefügt werden, um die aus der Tabelle abgerufenen Parameter zu identifizieren. Der Dateiname sieht folgendermaßen aus:

TXXXXX_PD_XXXX - P_M8_C2_R

Die abgerufenen (und damit variablen) Parameter sind: 8, 2 und R, alles andere ist unveränderlich.

Vielen Dank für Ihre Antwort:)

gt22 · 13. Februar 2017 um 11:12

Siehe diesen Link

https://forum.excel-pratique.com/excel/creation-de-dossier-a-partir-de-valeur-de-cellule-t69912.html

http://www.commentcamarche.net/forum/affich-32704381-creation-dossier-par-rapport-a-une-valeur-cellule-excel?page=2

https://www.developpez.net/forums/d1549758/logiciels/microsoft-office/excel/creation-dossier-excel-partir-d-cellule/

Tutorial zum Erstellen einer Datei

http://warin.developpez.com/access/fichiers/

Nicht getestet, um zu sehen

@+ ;-)

tmauduit · 13. Februar 2017 um 12:40

Ich habe mir im Detail angesehen, was Sie gepostet haben, aber es entspricht nicht wirklich meiner Anfrage, alles, was ich möchte, ist, nur eine Info in einer Zelle abzurufen und sie dann in einem Dialogfeld anzuzeigen, bevor ich die Datei speichere. Der Ordner, in den das Teil verschoben werden soll, ist bereits erstellt.

Cyril.f · 13. Februar 2017 um 13:23

Hallo

Ich verstehe die Aufforderung nicht ganz. Handelt es sich bei der Excel-Datei, in die Sie eingeben, um eine Auswahl durch den Benutzer, die zum Datensatznamen wird, oder um eine feste Zelle, in der Sie nach Informationen suchen?

tmauduit · 13. Februar 2017 um 14:18

@Cyril.f

Meine Zelle ist eine Verkettung einiger Informationen aus meiner Tabelle und meinem Text. Es befindet sich immer an der gleichen Stelle, da es nur ein Blatt und eine Excel-Datei gibt.

yvest · 13. Februar 2017 um 16:14

Hallo

Obwohl es mir schwer fällt, den Nutzen zu verstehen, wenn Sie eine Familie von Teilen durchgehen, die unterschiedliche Konfigurationen für Sie erstellen, werden Sie den Code finden, der dem entspricht, was ich aus Ihrer Frage verstanden habe:)

Entweder:

Öffnen einer Excel-Arbeitsmappe aus SOLIDWORKS
Abrufen des Werts einer Zelle
Umbenennen einer Datei (mit oder ohne den alten Namen)
Speichern Sie eine Kopie unter dem neuen Namen

Ich habe ein Dialogfeld hinzugefügt, um nach der Excel-Arbeitsmappe zu suchen.

Der Code:

"Denken Sie darüber nach, Microsoft Excel- und Office-Referenzen hinzuzufügen

Dim swApp als SldWorks.SldWorks
Dim xlApp As Excel.Application
Dim swDoc als ModelDoc2
Dim fDialog As Office.FileDialog
Dim xlDoc als Excel.Workbook
Dim xlCell als Excel.Range
Dim DocName, NewName, Folder, NewPath As String
Dim fso Als Objekt

Sub main()

Legen Sie swApp = Application.SldWorks fest
Festlegen von swDoc = swApp.ActiveDoc
Legen Sie xlApp = Neue Excel.Anwendung fest
Set fDialog = xlApp.FileDialog(msoFileDialogOpen)
"Sie können fDialog Optionen hinzufügen, um nur ein Dokument zu filtern oder zu öffnen
Wenn fDialog.Show = -1, dann
Set xlDoc = xlApp.Workbooks.Open(fDialog.SelectedItems(1))
Legen Sie xlCell = xlDoc.Worksheets(1) fest. Bereich ("A1")
"Ich erstelle ein fso-Objekt, um Dateien einfach zu manipulieren
Set fso = CreateObject("Scripting.fileSystemObject")

DocName = swDoc.GetPathName
Neuer Name = fso. GetBaseName(DocName) & " " & xlCell.Value
"Ich erstelle den neuen Dateinamen aus dem alten neu
Neuer Pfad = fso. GetParentFolderName(DocName) & "\" & NewName & "." & fso.getextensionName(DocName)
"Ich nehme auf
f = swDoc.SaveAs(NeuerPfad)

Ende, wenn

"Wir denken daran, das zu zerstören, was nicht mehr nützlich ist

Set fso = Nichts
Set xlApp = Nichts
Ende Sub

Viel Spaß:)

gt22 · 13. Februar 2017 um 18:35

tmauduit

Ich habe mir im Detail angesehen, was Sie gepostet haben, aber es entspricht nicht wirklich meiner Anfrage, alles, was ich möchte, ist, nur eine Info in einer Zelle abzurufen und sie dann in einem Dialogfeld anzuzeigen, bevor ich die Datei speichere. Der Ordner, in den das Teil verschoben werden soll, ist bereits erstellt.

Die Frage ist

Ich muss den Inhalt einer Zelle aus einer Excel-Datei abrufen und ihn dann als Dateinamen festlegen.

Das Ziel wäre daher:

-Stellen Sie den Inhalt der Zelle wieder her,

- Legen Sie es als Dateinamen in einem Dialogfeld fest und lassen Sie es dem Benutzer bearbeitbar, damit es interagieren kann.

also in den Links ist die Antwort da ;-(

Nun möchten Sie den Namen einer Datei ändern, die Sie bereits erstellt haben??????????????????????????

Vielleicht müssen Sie wissen, was Sie wollen!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

@+;-( Version überhaupt nicht glücklich ;-(

PS en + für welchen Nutzen????????????

tmauduit · 14. Februar 2017 um 08:19

@gt22 rufe ich den Namen aus der Zelle ab und füge ihn als neuen Namen für ein Save-Sub- in einen vorhandenen Ordner ein.

@industrialcadservice ich schaue mir das an!

Vielen Dank für Ihre Antworten:)

tmauduit · 14. Februar 2017 um 10:08

Nun, kleine Änderung mit Smartproperties: Ich definiere meinen TITLE3 mit Excel, rufe ihn dann über das Makro ab, aber immer noch ein Problem, mehr auf der Solidworks-Seite, in der Tat sind die Smart-Eigenschaften entweder mit dem Dokument oder mit der Konfiguration verknüpft, und mein Titel 3 ändert sich in der Konfiguration, aber nicht im Dokument, und es ist das des Dokuments, das ich zurückbekomme, und nicht das der Konfiguration... Weiß jemand, wo der Wolf ist?

Codeausschnitt unten

Legen Sie SWmoddoc = swApp.ActiveDoc fest.

Pfadname = UCase(SWmoddoc.GetPfadname)

Wenn right(PathName, 3) = "DRW" dann
    MesgBOX = MsgBox("Makro, das nur von einem Teil oder einer Baugruppe ausgeführt werden soll", vbMsgBoxSetForeground, "Speichern unter")
    Sub beenden
    ElseIf Right(Pfadname, 3) = "PRT" dann
        DRWPath = Ersetzen(Pfadname, "PRT", "DRW")
    ElseIf Right(Pfadname, 3) = "ASM" dann
        DRWPath = Ersetzen(Pfadname, "ASM", "DRW")
Ende, wenn

FilePath = Links(Pfadname, InStrRev(Pfadname, "\"))

Dateiname = Rechts(Pfadname, Len(Pfadname) - InStrRev(Pfadname, "\"))

RET = MsgBox("Haben Sie den Namen der Riemenscheibe/Trommel in Excel kopiert?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Speichern unter")

Wenn RET = vbAbbrechen, dann Ende
Tun

TITEL 3
Neuer Name = SWmoddoc.CustomInfo("TITEL3")

"Wir stellen es aus
RET = MsgBox(Neuer Name, vbMsgBoxSetForeground)
'NewName = InputBox("Bitte geben Sie den neuen Namen an, den Sie aus Excel abgerufen haben" & vbNewLine, "Speichern")

'Wenn StrPtr(NewName) = 0 dann
'Meldungsfeld 'Verfahren abgebrochen'

"U-Boot verlassen
"Ende, wenn

Vielen Dank im Voraus

yvest · 14. Februar 2017 um 11:13

Hallo

Ich sitze nicht vor meinem PC, gehe aber davon aus, dass SW die Eigenschaft der aktiven Konfiguration wiederherstellt. Haben Sie Ihr Makro mit einer anderen Konfiguration ausprobiert?

Wenn nicht, können Sie uns den Zweck solcher Manipulationen erklären? Denn ich persönlich sehe keinen Sinn darin...

tmauduit · 14. Februar 2017 um 13:13

Ich habe es mit einer anderen Konfiguration versucht, aber das Ergebnis ist dasselbe, die Titeländerung erfolgt nur auf der Excel-Seite und in der Konfiguration und nicht in der .prt-Datei selbst

Der Punkt ist, dass all dies dem Endbenutzer verborgen bleibt: Er konfiguriert, startet das Makro und validiert oder nicht den Namen. Ich stelle nur ein Excel mit seinen Parametern zur Eingabe bereit. Die Erstellung der Referenz erscheint zu keinem Zeitpunkt in Excel für den Benutzer.

tmauduit · 15. Februar 2017 um 10:58

Sub SAVE() 'Speichern unter
Dim swApp als SldWorks.SldWorks
Dimmen des Teils als SldWorks.ModelDoc
CODE als Zeichenfolge dimmen
Dim nErrors so lange
Dimmen nWarnungen so lange

Legen Sie swApp = Application.SldWorks fest
Set Part = swApp.ActiveDoc

Pfadname = UCase(Teil.GetPfadname)

Wenn right(PathName, 3) = "DRW" dann
    MesgBOX = MsgBox("Makro, das nur von einem Teil oder einer Baugruppe ausgeführt werden soll", vbMsgBoxSetForeground, "Speichern unter")
    Sub beenden
    ElseIf Right(Pfadname, 3) = "PRT" dann
        DRWPath = Ersetzen(Pfadname, "PRT", "DRW")
    ElseIf Right(Pfadname, 3) = "ASM" dann
        DRWPath = Ersetzen(Pfadname, "ASM", "DRW")
Ende, wenn

FilePath = Links(Pfadname, InStrRev(Pfadname, "\"))

Dateiname = Rechts(Pfadname, Len(Pfadname) - InStrRev(Pfadname, "\"))

RET = MsgBox("Sind Sie mit der Einrichtung Ihres Teils fertig?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Speichern unter")

Wenn RET = vbAbbrechen, dann Ende
Tun
    "Wir holen uns den TITEL zurück3
    NewName = Teil.CustomInfo("TITEL3")
    "Wir stellen es aus
    'RET = MsgBox(Neuer Name, vbMsgBoxSetForeground)
    NewName = InputBox("Validieren oder Ändern des Teilenamens" & vbNewLine & vbNewLine, "Namensdefinition", Neuer Name)

Wenn StrPtr(NewName) = 0, dann
MsgBox "Vorgang abgebrochen"

Sub beenden
Ende, wenn

Do while InStr(NewName, Chr(34)) > 0 oder InStr(NewName, "\") > 0 oder InStr(NewName, "/") > 0 _
oder InStr(NewName, ":") > 0 oder InStr(NewName, "*") > 0 oder InStr(NewName, "?") > 0 oder InStr(NewName, "<") > 0 oder InStr(NewName, ">") > 0 oder InStr(NewName, "|") > 0

        NewName = InputBox("Warnung, der Name enthält mindestens eines der verbotenen Zeichen \/:*?""<>|" & vbNewLine & vbNewLine & _
        "Bitte geben Sie den neuen Namen ein: ", "Speichern unter", Neuer Name)
    Schleife

Schleife, während NewName = ""

Tun
    FilePath = InputBox("In welchem Ordner möchten Sie das Teil speichern?", "Speichern unter", FilePath)
    Wenn StrPtr(FilePath) = 0, dann
        MsgBox "Vorgang abgebrochen"
        Sub beenden
    Ende, wenn
    Wenn Right(FilePath, 1) <> "\" dann FilePath = FilePath & "\"

    Wenn Dir$(FilePath) <> "" dann
        EXISTIERT = 1
    Ansonsten: MsgBox "Das Verzeichnis existiert nicht, bitte erstellen Sie es"
    Debug.Print Dir$(Dateipfad)
    Ende, wenn

Schleife, während EXISTS <> 1

Set swModel = swApp.ActivateDoc2(Pfadname, False, nErrors)

Wenn (Part.GetType = swDocASSEMBLY) dann

Part.SaveAs (FilePath + NewName + ". SLDASM")
ElseIf (Part.GetType = swDocPART) dann

Part.SaveAs (FilePath + NewName + ". SLDPRT")
Ende, wenn

Ende Sub

Das Problem auf der VBA-Seite ist für mich gelöst, ich öffne ein weiteres Thema für das Problem mit Smart Properties