[VBA] Stel de naam van een SLDPRT-bestand in op basis van een cel in het Excel-bestand van de gerelateerde onderdelenfamilie

tmauduit · 13 februari 2017 om 08:14

Hoi allemaal

Na verschillende mislukte pogingen, besloot ik wat meer hulp te komen halen.

Ik moet de inhoud van een cel in een Excel-bestand ophalen en deze vervolgens definiëren als een bestandsnaam.

Het doel zou dus zijn:

-De inhoud van de cel herstellen,

- Stel het in als een bestandsnaam in een dialoogvenster en laat het bewerkbaar voor de gebruiker om te communiceren,

- Opslaan als: - ofwel in een door de gebruiker gedefinieerde map,

-of op het bureau als het te ingewikkeld is.

Ik heb je mijn stukje code gemaakt met behulp van verschillende tutorials / codes die rechts en links zijn opgehaald

Dim swApp als object

Deel dimmen als object
Dim boolstatus als Booleaanse
Dim longstatus As Long, longwarnings As Long

Sub hoofd()

Stel swApp = Toepassing.SldWorks in
Deel instellen = swApp.ActiveDoc
Dim PartPath als tekenreeks
Dim Pathsize zo lang
Dim PathNoExtension als tekenreeks
Dim NewFileName als tekenreeks
Dim werkmappen als geheel getal

PartPath = Deel.GetPathName
Padgrootte = Tekenreeksen.Len(DeelPad)
PathNoExtension = Strings.Left(PartPath, Padgrootte - 7)

'NewFileName = InputBox("Vul de nieuwe naam in die in Excel is opgehaald", "Een kopie opslaan", NewFileName)
'Als NewFileName = "" Dan
NewFileName = Werkmappen ("ONTWERPTABEL"). Werkbladen ("Blad1"). Cellen(1, 9)

'Einde als

longstatus = Deel.SaveAs2(NieuwBestandsNaam & ".sldprt", 0, 1, 0)
'swApp.CloseDoc PartPath 'sluit oud document
Set Part = swApp.OpenDoc6(NewFileName & ".sldprt", 1, 0, "", longstatus, longwarnings)

Einde Sub

gt22 · 13 februari 2017 om 10:41

Vraag: Wat is de naam van uw Excel-cel?

Is het een concarnatie van x cellen?

omdat u wilt dat het de naam van een bestandsonderdeel is

@+ ;-)

tmauduit · 13 februari 2017 om 10:45

Ik heb de code gewijzigd, die efficiënter is dan de huidige.

Sub SAVE() 'opslaan als
Dim swApp als SldWorks.SldWorks
Dim SWmoddoc als SldWorks.ModelDoc2
Dim CODE als snaar
Dim nErrors zo lang
Dim nWaarschuwingen zo lang mogelijk
Stel swApp = Toepassing.SldWorks in
Stel SWmoddoc = swApp.ActiveDoc in

PathName = UCase(SWmoddoc.GetPathName)

Als right(PathName, 3) = "DRW" dan
    MesgBOX = MsgBox("Macro die alleen vanuit een onderdeel of assemblage moet worden uitgevoerd", vbMsgBoxSetForeground, "Opslaan als")
    Sub afsluiten
    ElseIf Right(PathName, 3) = "PRT" dan
        DRWPath = Vervangen(PadNaam, "PRT", "DRW")
    ElseIf Right(PathName, 3) = "ASM" dan
        DRWPath = Vervangen(PadNaam, "ASM", "DRW")
Einde als

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

FileName = Right(PathName, Len(PathName) - InStrRev(PathName, "\"))

RET = MsgBox("Heb je de naam van de katrol in Excel gekopieerd?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Opslaan als")

Als RET = vbCancel then end
Doen

NewName = InputBox ("Geef de nieuwe naam aan die uit Excel is gehaald" & vbNewLine, "Opslaan", FR-label)

Als StrPtr(NewName) = 0 dan
MsgBox "Procedure geannuleerd"

Sub afsluiten
Einde als

Doe terwijl InStr(NewName, Chr(34)) > 0 of InStr(NewName, "\") > 0 of InStr(NewName, "/") > 0 _
of InStr(NewName, ":") > 0 of InStr(NewName, "*") > 0 of InStr(NewName, "?") > 0 of InStr(NewName, "<") > 0 of InStr(NewName, ">") > 0 of InStr(NewName, "|") > 0

        NewName = InputBox("Waarschuwing, de naam bevat ten minste één van de verboden tekens \/:*?""<>|" & vbNewLine & vbNewLine & _
        "Voer de nieuwe naam in: ", "Opslaan als", NewName)
    Strik

Loop terwijl NewName = ""

Doen
    FilePath = InputBox("In welke map wilt u de katrol opslaan?", "Opslaan als", FilePath)
    Als StrPtr(FilePath) = 0 dan
        MsgBox "Procedure geannuleerd"
        Sub afsluiten
    Einde als
    Als Right(FilePath, 1) <> "\" dan is FilePath = FilePath & "\"

    Als dir$(FilePath) <> "" dan
        BESTAAT = 1
    Anders: MsgBox "De directory bestaat niet, maak hem aan"
    Debug.Print Dir$(FilePath)
    Einde als

Loop Terwijl BESTAAT <> 1

Stel swModel = swApp.ActivateDoc2(PathName, False, nErrors) in

Als (SWmoddoc.GetType = swDocASSEMBLY) Dan

SWmoddoc.SaveAs (FilePath + NewCode + NewName + ". SLDASM")
ElseIf (SWmoddoc.GetType = swDocPART) Dan

SWmoddoc.SaveAs (FilePath + NewName + ". SLDPRT")
Einde als

Einde Sub

Mijn gsm heeft geen specifieke naam. Het haalt eenvoudig informatie op uit de spreadsheet door letters toe te voegen om de parameters te identificeren die uit de spreadsheet zijn opgehaald. De bestandsnaam ziet er als volgt uit:

TXXXXX_PD_XXXX - P_M8_C2_R

De opgehaalde (en dus variabele) parameters zijn: 8, 2 en R, al het andere is onveranderlijk.

Dank u voor uw antwoord:)

gt22 · 13 februari 2017 om 11:12

Zie deze 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 voor het maken van een bestand

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

Niet getest om te zien

@+ ;-)

tmauduit · 13 februari 2017 om 12:40

Ik heb in detail gekeken naar wat je hebt gepost, maar het komt niet echt overeen met mijn verzoek, alles wat ik zou willen is gewoon een info ophalen in een cel en deze vervolgens weergeven in een dialoogvenster voordat het bestand wordt opgeslagen. De map waarin het onderdeel komt te staan is al aangemaakt.

Cyril_f · 13 februari 2017 om 13:23

Hallo

Ik begrijp het verzoek niet helemaal. Het excel-bestand waarin je typt, is het een selectie van de gebruiker die de recordnaam wordt of is het een vaste cel waarin je de informatie gaat zoeken?

tmauduit · 13 februari 2017 om 14:18

@Cyril.f

Mijn cel is een aaneenschakeling van informatie uit mijn spreadsheet en tekst. Het staat altijd op dezelfde plaats omdat er maar één blad en één Excel-bestand is.

yvest · 13 februari 2017 om 16:14

Hallo

Hoewel ik moeite heb om het nut te begrijpen als je door een familie van onderdelen gaat die verschillende configuraties voor je maken, zul je de code vinden die overeenkomt met wat ik uit je vraag begreep:)

Hetzij:

Open een Excel-werkmap vanuit solidworks
De waarde van een cel ophalen
De naam van een bestand wijzigen (met of zonder de oude naam)
Een kopie opslaan met de nieuwe naam

Ik heb een dialoogvenster toegevoegd om naar de Excel-werkmap te zoeken.

De code:

'Denk aan het toevoegen van Microsoft Excel- en Office-referenties

Dim swApp als SldWorks.SldWorks
Dim xlApp als Excel.Application
Dim swDoc als ModelDoc2
Dim fDialog als Office.FileDialog
Dim xlDoc als Excel.Werkmap
Dim xlCell als Excel.Range
Dim DocName, NewName, Map, NewPath als tekenreeks
Dim fso als object

Sub hoofd()

Stel swApp = Toepassing.SldWorks in
Stel swDoc in = swApp.ActiveDoc
Stel xlApp in = Nieuwe Excel.Toepassing
Stel fDialog in = xlApp.FileDialog(msoFileDialogOpen)
'U kunt opties toevoegen aan fDialog om te filteren of slechts één document te openen
Als fDialog.Show = -1 Dan
Stel xlDoc in = xlApp.Workbooks.Open(fDialog.SelectedItems(1))
Stel xlCell = xlDoc.Werkbladen(1) in. Bereik ("A1")
'Ik maak een fso-object om bestanden makkelijk te manipuleren
Stel fso in = CreateObject("Scripting.fileSystemObject")

DocName = swDoc.GetPathName
NieuwNaam = fso. GetBaseName(DocName) & " " & xlCell.Value
'Ik maak de nieuwe bestandsnaam opnieuw van de oude
NieuwPad = fso. GetParentFolderName(DocName) & "\" & NewName & "." & fso.getextensionName(DocName)
'Ik neem op
f = swDoc.SaveAs(NieuwPad)

Einde als

'We denken aan het vernietigen van wat niet meer nuttig is

Set fso = Niets
Set xlApp = Niets
Einde Sub

Veel plezier:)

gt22 · 13 februari 2017 om 18:35

tmauduit

Ik heb in detail gekeken naar wat je hebt gepost, maar het komt niet echt overeen met mijn verzoek, alles wat ik zou willen is gewoon een info ophalen in een cel en deze vervolgens weergeven in een dialoogvenster voordat het bestand wordt opgeslagen. De map waarin het onderdeel komt te staan is al aangemaakt.

De vraag is

Ik moet de inhoud van een cel uit een Excel-bestand halen en deze vervolgens als bestandsnaam instellen.

Het doel zou dus zijn:

-De inhoud van de cel herstellen,

- Stel het in als een bestandsnaam in een dialoogvenster en laat het bewerkbaar voor de gebruiker om te communiceren,

Dus in de links is het antwoord er ;-(

Nu wilt u de naam wijzigen van een bestand dat u al hebt gemaakt??????????????????????????

Misschien moet je weten wat je wilt!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

@+;-( versie helemaal niet blij ;-(

ps en + voor welk nut????????????

tmauduit · 14 februari 2017 om 08:19

@gt22, haal ik de naam uit de cel en injecteer deze als een nieuwe naam voor een save-sub- in een bestaande map.

@industrialcadservice ik kijk hiernaar!

Dank u voor uw antwoorden:)

tmauduit · 14 februari 2017 om 10:08

Nou ja, kleine wijziging met behulp van smartproperties: ik definieer mijn TITLE3 met behulp van Excel en haal het vervolgens op door de macro, maar nog steeds een probleem, meer aan de solidworks-kant, inderdaad, de slimme eigenschappen zijn gekoppeld aan het document, of aan de configuratie, en mijn titel 3 verandert in de configuratie, maar niet in het document, en het is die van het document die ik terugkrijg, en niet die van de configuratie... Weet iemand waar de wolf is?

Fragment van de code hieronder

Stel SWmoddoc = swApp.ActiveDoc in

PathName = UCase(SWmoddoc.GetPathName)

Als right(PathName, 3) = "DRW" dan
    MesgBOX = MsgBox("Macro die alleen vanuit een onderdeel of assemblage moet worden uitgevoerd", vbMsgBoxSetForeground, "Opslaan als")
    Sub afsluiten
    ElseIf Right(PathName, 3) = "PRT" dan
        DRWPath = Vervangen(PadNaam, "PRT", "DRW")
    ElseIf Right(PathName, 3) = "ASM" dan
        DRWPath = Vervangen(PadNaam, "ASM", "DRW")
Einde als

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

FileName = Right(PathName, Len(PathName) - InStrRev(PathName, "\"))

RET = MsgBox("Heb je de naam van de katrol/trommel in Excel gekopieerd?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Opslaan als")

Als RET = vbCancel then end
Doen

TITEL 3
NewName = SWmoddoc.CustomInfo("TITEL3")

'We tonen het
RET = MsgBox(NieuweNaam, vbMsgBoxSetForeground)
'NewName = InputBox ("Geef de nieuwe naam aan die is opgehaald uit Excel" & vbNewLine, "Opslaan")

'Als StrPtr(NewName) = 0 dan
"MsgBox "Procedure geannuleerd"

'Uitgang Sub
'Einde als

Bij voorbaat dank

yvest · 14 februari 2017 om 11:13

Hallo

Ik zit niet achter mijn pc, maar ik ga ervan uit dat SW de eigenschap van de actieve configuratie herstelt. Heb je je macro geprobeerd met een andere configuratie?

Zo nee, kunt u ons dan uitleggen wat het doel van dergelijke manipulaties is? Want persoonlijk zie ik het nut er niet van in...

tmauduit · 14 februari 2017 om 13:13

Ik heb het wel geprobeerd met een andere configuratie, maar het resultaat is hetzelfde, de titelwijziging wordt alleen gedaan aan de excel-kant en de configuratie, en niet in het .prt-bestand zelf

Het punt is dat dit alles verborgen is voor de eindgebruiker: hij configureert, start de macro en valideert de naam of niet. Ik geef gewoon een excel met zijn parameters om in te voeren. Het aanmaken van de referentie verschijnt op geen enkel moment in Excel voor de gebruiker.

tmauduit · 15 februari 2017 om 10:58

Sub SAVE() 'opslaan als
Dim swApp als SldWorks.SldWorks
Dim deel als SldWorks.ModelDoc
Dim CODE als snaar
Dim nErrors zo lang
Dim nWaarschuwingen zo lang mogelijk

Stel swApp = Toepassing.SldWorks in
Deel instellen = swApp.ActiveDoc

PathName = UCase(Deel.GetPathName)

Als right(PathName, 3) = "DRW" dan
    MesgBOX = MsgBox("Macro die alleen vanuit een onderdeel of assemblage moet worden uitgevoerd", vbMsgBoxSetForeground, "Opslaan als")
    Sub afsluiten
    ElseIf Right(PathName, 3) = "PRT" dan
        DRWPath = Vervangen(PadNaam, "PRT", "DRW")
    ElseIf Right(PathName, 3) = "ASM" dan
        DRWPath = Vervangen(PadNaam, "ASM", "DRW")
Einde als

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

FileName = Right(PathName, Len(PathName) - InStrRev(PathName, "\"))

RET = MsgBox("Ben je klaar met het instellen van je onderdeel?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Opslaan als")

Als RET = vbCancel then end
Doen
    'we krijgen de TITEL terug3
    NewName = Part.CustomInfo("TITEL3")
    'We tonen het
    'RET = MsgBox(NewName, vbMsgBoxSetForeground)
    NewName = InputBox ("Bevestig of wijzig de onderdeelnaam" & vbNewLine & vbNewLine, "Naamdefinitie", NewName)

Als StrPtr(NewName) = 0 dan
MsgBox "Procedure geannuleerd"

Sub afsluiten
Einde als

Doe terwijl InStr(NewName, Chr(34)) > 0 of InStr(NewName, "\") > 0 of InStr(NewName, "/") > 0 _
of InStr(NewName, ":") > 0 of InStr(NewName, "*") > 0 of InStr(NewName, "?") > 0 of InStr(NewName, "<") > 0 of InStr(NewName, ">") > 0 of InStr(NewName, "|") > 0

        NewName = InputBox("Waarschuwing, de naam bevat ten minste één van de verboden tekens \/:*?""<>|" & vbNewLine & vbNewLine & _
        "Voer de nieuwe naam in: ", "Opslaan als", NewName)
    Strik

Loop terwijl NewName = ""

Doen
    FilePath = InputBox("In welke map wilt u het onderdeel opslaan?", "Opslaan-als", FilePath)
    Als StrPtr(FilePath) = 0 dan
        MsgBox "Procedure geannuleerd"
        Sub afsluiten
    Einde als
    Als Right(FilePath, 1) <> "\" dan is FilePath = FilePath & "\"

    Als dir$(FilePath) <> "" dan
        BESTAAT = 1
    Anders: MsgBox "De directory bestaat niet, maak hem aan"
    Debug.Print Dir$(FilePath)
    Einde als

Loop Terwijl BESTAAT <> 1

Stel swModel = swApp.ActivateDoc2(PathName, False, nErrors) in

Als (Part.GetType = swDocASSEMBLY) Dan

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

Part.SaveAs (FilePath + NewName + ". SLDPRT")
Einde als

Einde Sub

Het probleem aan de VBA-kant is voor mij opgelost, ik open een ander onderwerp voor het probleem met Smart Properties