[VBA] Ustawianie nazwy pliku .sldprt na podstawie komórki w pliku programu Excel rodziny powiązanych części

tmauduit · 13 Luty 2017 08:14

Cze wszystkim

Po kilku nieudanych próbach postanowiłem przyjechać i uzyskać trochę więcej pomocy.

Muszę pobrać zawartość komórki w pliku programu Excel, a następnie zdefiniować ją jako nazwę pliku.

Celem byłoby zatem:

-Odzyskać zawartość komórki,

- Ustaw go jako nazwę pliku w oknie dialogowym i pozostaw go edytowalnym, aby użytkownik mógł z nim współpracować,

- Zapisz jako: - albo w folderze zdefiniowanym przez użytkownika,

-lub na biurku, jeśli jest zbyt skomplikowane.

Umieściłem ci mój kawałek kodu wykonany za pomocą różnych samouczków/kodów pobranych na prawo i lewo

Dim swApp As Object

Przyciemnij część jako obiekt
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Ustaw swApp = Application.SldWorks
Ustaw część = swApp.ActiveDoc
Przyciemnij ścieżkę części jako ciąg
Przyciemnij rozmiar ścieżki tak długiej, jak długo
Dim PathNoExtension As Ciąg
Dim NewFileName As Ciąg
Przyciemnij skoroszyty jako liczbę całkowitą

PartPath = Nazwa_Part.GetPathName
Pathsize = Strings.Len(PartPath)
PathNoExtension = Strings.Left(PartPath, Pathsize - 7)

'NewFileName = InputBox("Wpisz nową nazwę pobraną w Excelu", "Zapisz kopię", NewFileName)
'If NewFileName = "" Then
NewFileName = Skoroszyty("TABLICA PROJEKTOWA"). Arkusze robocze("Arkusz1"). Komórki(1, 9)

"Koniec, jeśli

longstatus = Part.SaveAs2(Nowa nazwaPliku & ".sldprt", 0, 1, 0)
'swApp.CloseDoc PartPath 'zamyka stary dokument
Ustaw część = swApp.OpenDoc6(NewFileName & ".sldprt", 1, 0, "", longstatus, longwarnings)

Koniec subwoofera

gt22 · 13 Luty 2017 10:41

Pytanie Jak nazywa się komórka programu Excel?

Czy jest to konkurenacja komórek x?

ponieważ chcesz, aby była to nazwa części pliku

@+ ;-)

tmauduit · 13 Luty 2017 10:45

Zmieniłem kod, który jest bardziej wydajny niż obecny.

Sub SAVE() 'zapisz jako
Dim swApp jako SldWorks.SldWorks
Przyciemnij SWmoddoc jako SldWorks.ModelDoc2
Przyciemnij KOD Jako ciąg
Dim nErrors tak długo, jak długo
Dim nWarnings tak długo, jak długo
Ustaw swApp = Application.SldWorks
Ustaw SWmoddoc = swApp.ActiveDoc

PathName = UCase(SWmoddoc.GetPathName)

Jeśli Right(PathName, 3) = "DRW" Następnie
    MesgBOX = MsgBox("Makro do uruchomienia tylko z części lub złożenia", vbMsgBoxSetForeground, "Zapisz jako")
    Wyjdź z subwoofera
    ElseIf Right(PathName, 3) = "PRT" Następnie
        DRWPath = Zamień(nazwa_ścieżki, "PRT", "DRW")
    ElseIf Right(PathName, 3) = "ASM" Następnie
        DRWPath = Replace(nazwa_ścieżki, "ASM", "DRW")
Zakończ jeżeli:

FilePath = Left(NazwaŚcieżki, InStrRev(NazwaŚcieżki, "\"))

NazwaPliku = Right(NazwaŚcieżki, Len(NazwaŚcieżki) - InStrRev(NazwaŚcieżki, "\"))

RET = MsgBox("Czy skopiowałeś nazwę koła pasowego w Excelu?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Zapisz jako")

Jeśli RET = vbAnuluj, to Koniec
Robić

NewName = InputBox("Proszę wskazać nową nazwę pobraną z Excela" & vbNewLine, "Zapisz", etykieta FR)

Jeśli StrPtr(NewName) = 0, to
MsgBox "Procedura anulowana"

Wyjdź z subwoofera
Zakończ jeżeli:

Wykonaj while InStr(nowaNazwa, Chr(34)) > 0 lub InStr(NowaNazwa, "\") > 0 lub InStr(NowaNazwa, "/") > 0 _
lub InStr(NowaNazwa, ":") > 0 lub InStr(NowaNazwa, "*") > 0 lub InStr(NowaNazwa, "?") > 0 lub InStr(NowaNazwa, "<") > 0 lub InStr(NowaNazwa, ">") > 0 lub InStr(NowaNazwa, "|") > 0

        NewName = InputBox("Ostrzeżenie, nazwa zawiera co najmniej jeden z zabronionych znaków \/:*?""<>|" & vbNewLine & vbNewLine & _
        "Wprowadź nową nazwę: ", "Zapisz jako", Nowa Nazwa)
    Pętla

Pętla, podczas gdy NewName = ""

Robić
    FilePath = InputBox("W którym folderze chcesz zapisać koło pasowe?", "Zapisz jako", FilePath)
    Jeśli StrPtr(ŚcieżkaPliku) = 0, to
        MsgBox "Procedura anulowana"
        Wyjdź z subwoofera
    Zakończ jeżeli:
    Jeśli Right(FilePath, 1) <> "\", to FilePath = FilePath & "\"

    Jeśli Dir$(FilePath) <> "" to
        ISTNIEJE = 1
    W przeciwnym razie: MsgBox "Katalog nie istnieje, utwórz go"
    Debug.Print Dir$(FilePath)
    Zakończ jeżeli:

Pętla, gdy ISTNIEJE <> 1

Set swModel = swApp.ActivateDoc2(NazwaŚcieżki, Fałsz, nBłędy)

Jeśli (SWmoddoc.GetType = swDocASSEMBLY) Wtedy

SWmoddoc.SaveAs (ŚcieżkaPliku + NowyKod + NowaNazwa+ ". SLDASM")
ElseIf (SWmoddoc.GetType = swDocPART) Następnie

SWmoddoc.SaveAs (ŚcieżkaPliku + NowaNazwa+ ". SLDPRT")
Zakończ jeżeli:

Koniec subwoofera

Moja komórka nie ma konkretnej nazwy. Po prostu pobiera informacje z arkusza kalkulacyjnego, dodając litery identyfikujące parametry pobrane z arkusza kalkulacyjnego. Nazwa pliku wygląda następująco:

TXXXXX_PD_XXXX - P_M8_C2_R

Pobierane parametry (a więc zmienne) to: 8, 2 i R, wszystko inne jest niezmienne.

Dziękuję za odpowiedź :)

gt22 · 13 Luty 2017 11:12

Zobacz ten 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/

Samouczek dotyczący tworzenia pliku

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

Nie testowano, aby zobaczyć

@+ ;-)

tmauduit · 13 Luty 2017 12:40

Przyjrzałem się szczegółowo temu, co opublikowałeś, ale tak naprawdę nie odpowiada to mojej prośbie, wszystko, czego chciałbym, to po prostu pobrać informacje w komórce, a następnie wyświetlić je w oknie dialogowym przed zapisaniem pliku. Folder, do którego trafi część, jest już utworzony.

Cyril_f · 13 Luty 2017 13:23

Witam

Nie do końca rozumiem tę prośbę. Plik Excela, w którym wpisujesz, czy jest to wybór dokonany przez użytkownika, który staje się nazwą rekordu, czy też jest to stała komórka, w której będziesz szukać informacji?

tmauduit · 13 Luty 2017 14:18

@Cyril.f

Moja komórka jest konkatenacją niektórych informacji z arkusza kalkulacyjnego i tekstu. Jest zawsze w tym samym miejscu, ponieważ jest tylko jeden arkusz i jeden plik Excela.

yvest · 13 Luty 2017 16:14

Witam

Chociaż trudno mi zrozumieć przydatność, jeśli przejdziesz przez rodzinę części, które tworzą dla Ciebie różne konfiguracje, znajdziesz kod, który odpowiada temu, co zrozumiałem z Twojego pytania :)

albo:

Otwieranie skoroszytu programu Excel z solidworks
Pobieranie wartości komórki
Zmienianie nazwy pliku (ze starą nazwą lub bez niej)
Zapisywanie kopii pod nową nazwą

Dodałem okno dialogowe do wyszukiwania skoroszytu programu Excel.

Kod:

"Pomyśl o dodaniu odwołań do programu Microsoft Excel i pakietu Office

Dim swApp jako SldWorks.SldWorks
Dim xlApp As Excel.Application
Dim swDoc As ModelDoc2
Dim fDialog As Office.FileDialog
Przyciemnij xlDoc jako Excel.Workbook
Przyciemnij xlCell jako Excel.Range
Dim DocName, NewName, Folder, NewPath As String
Dim fso Jako obiekt

Sub main()

Ustaw swApp = Application.SldWorks
Ustaw swDoc = swApp.ActiveDoc
Ustaw xlApp = Nowy Excel.Aplikacja
Ustaw fDialog = xlApp.FileDialog(msoFileDialogOpen)
'Możesz dodać opcje do fDialog, aby filtrować lub otwierać tylko jeden dokument
Jeśli fDialog.Show = -1 Następnie
Ustaw xlDoc = xlApp.Workbooks.Open(fDialog.SelectedItems(1))
Ustaw xlCell = xlDoc.Worksheets(1). Zakres("A1")
"Tworzę obiekt fso, aby łatwo manipulować plikami
Ustaw fso = CreateObject("Scripting.fileSystemObject")

DocName = swDoc.GetPathName
NewName = fso. GetBaseName(DocName) & " " & xlCell.Value
"Odtwarzam nową nazwę pliku ze starej
NewPath = fso. GetParentFolderName(DocName) & "\" & NewName & "." & fso.getextensionName(DocName)
"Nagrywam
f = swDoc.SaveAs(nowaŚcieżka)

Zakończ jeżeli:

"Myślimy o zniszczeniu tego, co nie jest już przydatne

Ustaw fso = Nic
Ustaw xlApp = Nic
Koniec subwoofera

Baw się dobrze :)

gt22 · 13 Luty 2017 18:35

tmauduit powiedział:

Przyjrzałem się szczegółowo temu, co opublikowałeś, ale tak naprawdę nie odpowiada to mojej prośbie, wszystko, czego chciałbym, to po prostu pobrać informacje w komórce, a następnie wyświetlić je w oknie dialogowym przed zapisaniem pliku. Folder, do którego trafi część, jest już utworzony.

Pytanie brzmi

Muszę pobrać zawartość komórki z pliku programu Excel, a następnie ustawić ją jako nazwę pliku.

Celem byłoby zatem:

-Odzyskać zawartość komórki,

- Ustaw go jako nazwę pliku w oknie dialogowym i pozostaw go edytowalnym, aby użytkownik mógł z nim współpracować,

więc w linkach odpowiedź jest ;-(

Teraz chcesz zmienić nazwę pliku, który już utworzyłeś??????????????????????????

Może musisz wiedzieć, czego chcesz!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

@+;-( wersja wcale nie jest zadowolona ;-(

PS en + do czego używać????????????

tmauduit · 14 Luty 2017 08:19

@gt22 pobieram nazwę z komórki i wstrzykuję ją jako nową nazwę dla pliku podrzędnego zapisu w istniejącym folderze.

@industrialcadservice Patrzę na to!

Dziękuję za odpowiedzi :)

tmauduit · 14 Luty 2017 10:08

Cóż, mała modyfikacja za pomocą smartproperties: definiuję mój TITLE3 za pomocą Excela, a następnie pobieram go za pomocą makra, ale nadal jest problem, więcej po stronie solidworks, rzeczywiście, inteligentne właściwości są połączone albo z dokumentem, albo z konfiguracją, a mój tytuł 3 zmienia się w konfiguracji, ale nie w dokumencie, i to jest ten z dokumentu, który dostaję z powrotem, a nie ten z konfiguracji... Czy ktoś wie, gdzie jest wilk?

Fragment kodu poniżej

Ustaw SWmoddoc = swApp.ActiveDoc

PathName = UCase(SWmoddoc.GetPathName)

Jeśli Right(PathName, 3) = "DRW" Następnie
    MesgBOX = MsgBox("Makro do uruchomienia tylko z części lub złożenia", vbMsgBoxSetForeground, "Zapisz jako")
    Wyjdź z subwoofera
    ElseIf Right(PathName, 3) = "PRT" Następnie
        DRWPath = Zamień(nazwa_ścieżki, "PRT", "DRW")
    ElseIf Right(PathName, 3) = "ASM" Następnie
        DRWPath = Replace(nazwa_ścieżki, "ASM", "DRW")
Zakończ jeżeli:

FilePath = Left(NazwaŚcieżki, InStrRev(NazwaŚcieżki, "\"))

NazwaPliku = Right(NazwaŚcieżki, Len(NazwaŚcieżki) - InStrRev(NazwaŚcieżki, "\"))

RET = MsgBox("Czy skopiowałeś nazwę koła pasowego/bębna w Excelu?", vbOKCancel + vbExquiation + vbMsgBoxSetForeground + vbSystemModal, "Zapisz jako")

Jeśli RET = vbAnuluj, to Koniec
Robić

TYTUŁ 3
NewName = SWmoddoc.CustomInfo("TYTUŁ3")

– Pokazujemy to
RET = MsgBox(NowaNazwa, vbMsgBoxSetForeground)
'NewName = InputBox("Proszę wskazać nową nazwę pobraną z Excela" & vbNewLine, "Zapisz")

'Jeśli StrPtr(NowaNazwa) = 0 to
'MsgBox "Procedura anulowana"

"Wyjdź z sub
"Koniec, jeśli

Z góry dziękuję

yvest · 14 Luty 2017 11:13

Witam

Nie jestem przed moim komputerem, ale zakładam, że oprogramowanie odzyskuje właściwość aktywnej konfiguracji. Czy wypróbowałeś swoje makro z inną konfiguracją?

Jeśli nie, czy może nam Pan/Pani wyjaśnić cel takich manipulacji? Bo osobiście nie widzę w tym sensu...

tmauduit · 14 Luty 2017 13:13

Próbowałem z inną konfiguracją, ale wynik jest taki sam, zmiana tytułu odbywa się tylko po stronie excela i konfiguracji, a nie w samym pliku .prt

Chodzi o to, że wszystko to jest ukryte przed użytkownikiem końcowym: konfiguruje, uruchamia makro i weryfikuje lub nie nazwę . Po prostu udostępniam excela z jego parametrami do wprowadzenia. Utworzenie odwołania nie pojawia się w żadnym momencie w programie Excel dla użytkownika.

tmauduit · 15 Luty 2017 10:58

Sub SAVE() 'zapisz jako
Dim swApp jako SldWorks.SldWorks
Przyciemnij część jako SldWorks.ModelDoc
Przyciemnij KOD Jako ciąg
Dim nErrors tak długo, jak długo
Dim nWarnings tak długo, jak długo

Ustaw swApp = Application.SldWorks
Ustaw część = swApp.ActiveDoc

PathName = UCase(Part.GetPathName)

Jeśli Right(PathName, 3) = "DRW" Następnie
    MesgBOX = MsgBox("Makro do uruchomienia tylko z części lub złożenia", vbMsgBoxSetForeground, "Zapisz jako")
    Wyjdź z subwoofera
    ElseIf Right(PathName, 3) = "PRT" Następnie
        DRWPath = Zamień(nazwa_ścieżki, "PRT", "DRW")
    ElseIf Right(PathName, 3) = "ASM" Następnie
        DRWPath = Replace(nazwa_ścieżki, "ASM", "DRW")
Zakończ jeżeli:

FilePath = Left(NazwaŚcieżki, InStrRev(NazwaŚcieżki, "\"))

NazwaPliku = Right(NazwaŚcieżki, Len(NazwaŚcieżki) - InStrRev(NazwaŚcieżki, "\"))

RET = MsgBox("Czy skończyłeś ustawiać swoją część?", vbOKCancel + vbExquiation + vbMsgBoxSetForeground + vbSystemModal, "Zapisz jako")

Jeśli RET = vbAnuluj, to Koniec
Robić
    "odzyskujemy TYTUŁ3
    NewName = Part.CustomInfo("TYTUŁ3")
    – Pokazujemy to
    'RET = MsgBox(NowaNazwa, vbMsgBoxSetForeground)
    NewName = InputBox("Sprawdź poprawność lub zmień nazwę części" & vbNewLine & vbNewLine, "Definicja nazwy", NewName)

Jeśli StrPtr(NewName) = 0, to
MsgBox "Procedura anulowana"

Wyjdź z subwoofera
Zakończ jeżeli:

Wykonaj while InStr(nowaNazwa, Chr(34)) > 0 lub InStr(NowaNazwa, "\") > 0 lub InStr(NowaNazwa, "/") > 0 _
lub InStr(NowaNazwa, ":") > 0 lub InStr(NowaNazwa, "*") > 0 lub InStr(NowaNazwa, "?") > 0 lub InStr(NowaNazwa, "<") > 0 lub InStr(NowaNazwa, ">") > 0 lub InStr(NowaNazwa, "|") > 0

        NewName = InputBox("Ostrzeżenie, nazwa zawiera co najmniej jeden z zabronionych znaków \/:*?""<>|" & vbNewLine & vbNewLine & _
        "Wprowadź nową nazwę: ", "Zapisz jako", Nowa Nazwa)
    Pętla

Pętla, podczas gdy NewName = ""

Robić
    FilePath = InputBox("W którym folderze chcesz zapisać część?", "Zapisz jako", FilePath)
    Jeśli StrPtr(ŚcieżkaPliku) = 0, to
        MsgBox "Procedura anulowana"
        Wyjdź z subwoofera
    Zakończ jeżeli:
    Jeśli Right(FilePath, 1) <> "\", to FilePath = FilePath & "\"

    Jeśli Dir$(FilePath) <> "" to
        ISTNIEJE = 1
    W przeciwnym razie: MsgBox "Katalog nie istnieje, utwórz go"
    Debug.Print Dir$(FilePath)
    Zakończ jeżeli:

Pętla, gdy ISTNIEJE <> 1

Set swModel = swApp.ActivateDoc2(NazwaŚcieżki, Fałsz, nBłędy)

Jeśli (Part.GetType = swDocASSEMBLY) Następnie

Part.SaveAs (ŚcieżkaPliku + NowaNazwa+ ". SLDASM")
ElseIf (Part.GetType = swDocPART) Następnie

Part.SaveAs (ŚcieżkaPliku + NowaNazwa+ ". SLDPRT")
Zakończ jeżeli:

Koniec subwoofera

Problem po stronie VBA został dla mnie rozwiązany, otwieram inny temat dotyczący problemu z Smart Properties