Macro die SLDDRW-conversie in PDF/DWG mogelijk maakt met selectievakje en userfrom

skyzio · 25 augustus 2015 om 07:32

Hoi allemaal

Ik ben momenteel bezig met het aanpassen van een bestaande macro zodat deze zich aanpast aan mijn beperkingen.

De bestaande macro maakt het mogelijk om het SLDDRW-bestand te converteren naar PDF en DXF met de keuze van de bron- en doelmap en de naam te wijzigen na de herziening van het plan.

Kort...

In mijn geval zou ik graag willen converteren naar PDF en DWG zonder me zorgen te maken over de revisie, maar dat we een keuze kunnen hebben (zoals selectievakje tussen PDF en DWG.

Het is me gelukt om enkele wijzigingen aan te brengen (zoals het verwijderen van alles wat met de revisie te maken heeft) en DXF naar DWG te wijzigen en mijn chexboxen op de Userfrom te plaatsen.

Maar aan de andere kant, voor de codering van de selectievakjes heb ik een probleem (wetende dat ik niet veel fles in VBA heb, heb ik iets geprobeerd, maar hey).

Heb je een idee?

Dank je wel:)

Hier is een deel van de code:

Privé Sub FiltreBox_Change()
StartConvert.Enabled = Onwaar
TextSource.Caption = "Bronmap valideren"
TextSource.Voorkleur = RGB(255, 0, 0)
OkSource = Onwaar
CheckSource.Enabled = Waar
Einde Sub

Privé Sub SourceBox_Change()
StartConvert.Enabled = Onwaar
TextSource.Caption = "Bronmap valideren"
TextSource.Voorkleur = RGB(255, 0, 0)
OkSource = Onwaar
CheckSource.Enabled = Waar
Einde Sub
Privé Sub CheckBox1_Click()

Einde Sub

Privé Sub CheckBox2_Click()

Einde Sub

Privé Sub StartConvert_Click()
Stel swApp = Toepassing.SldWorks in

Tijddebuut = Timer
DestinationFileNumber = 0
FileName = Dir(PathDepart & FilterBox.Value & ". SLDDRW")
' Begint de lus

Doen terwijl FileName<> ""
DestinationFileNumber = DestinationFileNumber + 1
Advance.Caption = "Bestand verwerken" & DestinationFileNumber &" / " & FileSource Number & " : " & FileName
SaveDir.Repaint
FileNameWithoutExtension = Links(Bestandsnaam, Len(Bestandsnaam) - 7)
Het bestand openen
Set Part = swApp.OpenDoc6(PathDepart & FileName, 3, 0, "", longstatus, longwarnings)
swApp.OpenDoc6 PathDepartir & FileName, 3, 0, "", longstatus, longwarnings
Set Part = swApp.ActivateDoc2(FileName, False, longstatus)
Set swCustPrpMgr = Part.Extension.CustomPropertyManager("")
Creatie van het pdf-bestand
Als CheckBox1.Value = Waar Dan
Part.Extension.SaveAs PathArrival & FileNameWithoutExtension & ".pdf", 0, 0, Nothing, longstatus, longwarnings
Einde als
'Het aanmaken van het dwg-bestand
Als CheckBox1.Value = Waar Dan
Part.Extension.SaveAs PathArrivee & FileNameWithoutExtension & ".dwg", 0, 0, Nothing, longstatus, longwarnings
Einde als
"Afsluiting van het plan
Set Deel = Niets
swApp.CloseDoc Bestandsnaam

FileName = Dir ' Krijgt de volgende invoer.
Strik

StartConvert.Enabled = Onwaar
TimeFin = Timer

Progress.Caption = "Bewerking voltooid." & DestinationFileNumber & " / " & FileSourceNumber&" bestand(en) verwerkt. Verstreken tijd: " & TimeSerial(0, 0, TimeFin - TimeDebut)

Einde Sub

Privé Sub UserForm_Initialize()
OkSource = Onwaar
OkSource = Onwaar
StartConvert.Enabled = Onwaar
FiltreBox.Value = "*"
TextSource.Caption = "Introduceer en valideer de brondirectory"
TextSource.Voorkleur = RGB(255, 0, 0)
TextDestination.Caption = "Voer de doeldirectory in en valideer deze"
TextDestination.ForeColor = RGB(255, 0, 0)
SourceBox.Value = "Z:\deals"
DestinationBox.Value = "Z:\deals"
Vooruitgang.Onderschrift = ""
Einde Sub

remrem · 25 augustus 2015 om 07:59

Hallo

Geef de rollen van CheckBox1 en CheckBox2 op en wat u ermee wilt doen.

Het werkingsprincipe van een selectievakje:

Het heeft een waarde-eigenschap die varieert tussen waar en onwaar.

Als u deze wijziging wilt gebruiken, moet u de gebeurtenis Klikken gebruiken.

Voorbeeld:

Privé Sub CheckBox1_Click()
     Als CheckBox1.Value = Waar Dan
          MsgBox ("Actie zo waar")
     ElseIf CheckBox1.Value = Onwaar Dan
          MsgBox ("Actie indien onwaar")
     Einde als

Einde Sub

skyzio · 25 augustus 2015 om 08:02

Oké, dank je,

Ik ga het proberen. Ik hou je op de hoogte ;)

skyzio · 25 augustus 2015 om 11:25

Het werkt, het is geweldig!

nog iets,

Ik wil graag een foutmelding msgbox als er geen selectievakje is aangevinkt.

Ik dacht dat ik dit zou schrijven:

Sub msgbox()
Als CheckBox1.Value = Onwaar dan
ElseIf CheckBox2.Value = Onwaar Dan
Selecteer Case msgbox ("Kies alstublieft een conversie!", vbExclamation, "Conversiefout")
Einde Sub

remrem · 25 augustus 2015 om 11:47

Voor uw code:

Sub msgbox()
     Als CheckBox1.Value = Onwaar en CheckBox2.Value = Onwaar, dan
          Msgbox("Kies alstublieft een conversie!", vbExclamation, "Error conversion")
     Einde als
Einde Sub

Maar bij het programmeren is het, indien mogelijk, altijd beter om de gebruiker niet iets stoms te laten doen in plaats van hem te vertellen dat hij er een heeft gedaan.

Daarom denk ik dat je een knop in je Userform hebt die de conversie start. Stel je voor dat je hem Bouton_Lancement hebt benoemd.

Private Sub CheckBox1_Click() 'Deze sub bestaat al, dus voeg de onderstaande code toe

     Als CheckBox1.Value = Onwaar en CheckBox2.Value = Onwaar, dan
          Bouton_Lancement.Visible = Onwaar
     Anders als CheckBox1.Value = Waar of CheckBox2.Value = Waar Dan
          Bouton_Lancement.Visible = Waar
     Einde als

Einde Sub

Doe dan hetzelfde met de functie van het evenement CheckBox2_Click

Met deze code kun je de startknop onzichtbaar maken, zodat je niet verder kunt gaan. Het zal dus niet nodig zijn om de gebruiker te berispen ;-)

In de hoop je geholpen te hebben.

razflash · 25 augustus 2015 om 15:56

Hallo

Heeft u de link om de basismacro te downloaden?

Bij voorbaat dank

skyzio · 26 augustus 2015 om 07:39

Dank u voor uw antwoord,

Ik zal ernaar kijken en je vertellen of het werkt.

RazFlash: Ik ben op zoek naar het en als ik het vind, zal ik je de link geven.

skyzio · 26 augustus 2015 om 08:21

Hij geeft me een fout als ik de tweede oplossing stel.

"Compilatie fout:

Deze instructie moet de eerste in de rij zijn"

de -> regel "Else If CheckBox1.Value = True or CheckBox2.Value = True Then" is geschreven in rood

skyzio · 26 augustus 2015 om 08:26

Razflash:

Ik kon de originele link niet vinden...

Maar ik heb het originele bestand.

Ik heb het bijgevoegd.

savediraspdf_v1.1.zip

remrem · 26 augustus 2015 om 08:40

Spatie fout:

Private Sub CheckBox1_Click() 'Deze sub bestaat al, dus voeg de onderstaande code toe

     Als CheckBox1.Value = Onwaar en CheckBox2.Value = Onwaar, dan
          Bouton_Lancement.Visible = Onwaar
     ElseIf CheckBox1.Value = Waar Of CheckBox2.Value = Waar Dan
          Bouton_Lancement.Visible = Waar
     Einde als

Einde Sub

razflash · 27 augustus 2015 om 09:00

Bedankt voor het bestand!

skyzio · 1 september 2015 om 08:32

Dsl van de retourzending.

Bedankt, het werkt heel goed.

Ik zal nog andere wijzigingen moeten aanbrengen, denk ik, vooral op het niveau van de bronmap en het bestemmingsbestand waar ik graag een bladerknop zou willen hebben in plaats van de link te plakken, maar ik zal het later doen.

Dank je wel herinnering.

remrem · 1 september 2015 om 08:41

Hallo

Maar graag gedaan...

Voel je vrij om meer vragen te stellen voor je verbeteringen.

Fijne dag.