---

Guten Tag zusammen,

Wie der Betreff schon vermuten lässt möchte ich gerne Thumbnail Bilder, zum Zweck der Datenpflege, in einem ERP System via VBA exportieren. Das Gnaze gelingt auch recht gut. Das Problem dabei ist das export-Format, mit dem mein ERP System nicht klar kommt. Am liebsten wäre mir .jpg und das Ganze am besten Skaliert auf 200x200. Leider exportiert VBA als .wmf mit 213x213.

Besteht eine Möglichkeit Bilder via VBA zu skalieren bzw zu formatieren ?

MFG

[Diese Nachricht wurde von DrChiwago am 17. Mrz. 2016 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Wie wird denn exportiert vba? 
Wenn ja poste mal den code txt file
Eigentlich einfach
Thisdocument.view.saveasbitmap

------------------
************************************
 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Also schonmal vorweg, ich bin kein Profi was das angeht  

If ThisApplication.ActiveDocument.DocumentType = kAssemblyDocumentObject Then

    Set InvDocs = ThisApplication.ActiveDocument.AllReferencedDocuments
   
        Dim File As String
        Dim K As Integer
        Dim Invdocument As Document
        Dim Nummer As Property
        Dim Status As Property
        Dim thumb As IPictureDisp
        Dim i As Integer
        K = 0
    
       
        For i = 1 To InvDocs.Count
        Set Invdocument = InvDocs.Item(i)
        Set Nummer = Invdocument.PropertySets.Item("Design Tracking Properties").Item("Stock Number")
        Set Status = Invdocument.PropertySets.Item("Design Tracking Properties").Item("Description")
       
        If Nummer.Value = "" Or Status.Value <> "" Then
        K = K + 1
        GoTo Sprung:
        End If
       
        Set thumb = Invdocument.Thumbnail
       
        File = Nummer.Value & ".wmf"
       
      
        Call SavePicture(thumb, "C:\Users\***\Desktop\" & File)
       
Sprung:
       
        Next
       
    MsgBox InvDocs.Count - K & " Bilder wurden exportiert" & vbCrLf & _
    K & " Teile enthielten keine Nummer und wurden übersprungen"
   
    ' ------------------------------------------------------
   
ElseIf ThisApplication.ActiveDocument.DocumentType = kPartDocumentObject Then

        Dim InvDocs2 As Document
        Dim Nummer2 As Property
        Dim thumb2 As IPictureDisp
        Dim File2 As String
        Dim Status2 As Property
       
       
        Set InvDocs2 = ThisApplication.ActiveDocument
        Set Nummer2 = InvDocs2.PropertySets.Item("Design Tracking Properties").Item("Stock Number")
        Set Status2 = InvDocs2.PropertySets.Item("Design Tracking Properties").Item("Description")
       
        If Nummer2.Value <> "" And Status2.Value = "" Then
       
        Set thumb2 = InvDocs2.Thumbnail
        File2 = Nummer2.Value & ".wmf"
        Call SavePicture(thumb2, "C:\Users\***\Desktop\" & File2)
        MsgBox ("Thumbnail wurde exportiert")
       
        Else
        MsgBox ("Das aktive Dokument hat keine Bestandsnummer")
       
        End If
       
   ' -----------------------------------------------------------

ElseIf ThisApplication.ActiveDocument.DocumentType <> kPartDocumentObject And _
        ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
       
        MsgBox ("Das aktive Dokument enthällt keine lesbaren Bauteile")

End If

   
End Sub

[Diese Nachricht wurde von DrChiwago am 17. Mrz. 2016 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ok das geht einfacher
Bin ab dem 26 wieder in Deutschland wenn du solange warten kannst

------------------
************************************
 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von Frank_Schalla:
Ok das geht einfacher
Bin ab dem 26 wieder in Deutschland wenn du solange warten kannst

---

Hauptsache ich werde aufgeklärt  

Achso, zu dem Thema fällt mir eine weitere Frage ein :

besteht die Möglichkeit Thumbnails zu aktualisieren ? Denn einige werden fehlerhaft oder als Skizze dargestellt

[Diese Nachricht wurde von DrChiwago am 18. Mrz. 2016 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Cad_De_Vorschaubilder.txt

So wie angekündigt hier etwas was dir helfen sollte.
Kopiere den Inhalt der textdatei einfach mal in den VBA >Editor einer Baugruppe und starte dann das Makro DO_JPG
Hinweise zur Anpassung deinerseits.
1) In der folgenden Zeile wird das Startverzeichniss gesetzt.
  Einfach nur auf den Dektop des Users fand ich nicht so pralle 

  dirName = "C:\Temp\caddetest\"

Dort wird dann ein Unterverzeichniss mit einem Zeitstempel des Startes und Baugruppennamen/Bauteilname gebildet.
Alle JPG's welche die Notwendigen Infos haben landen dort.
Wenn die Info Stock Number fehlt landet ein JPG im Unterordner
NO_STOCK_NUMBER
Wenn die Info Description fehlt landet ein JPG im Unterordner
NO_STATUS_DESCRIPTION

Vor dem Speichern des JPG's wird die Ansicht noch ein wenig aufgeräumt und auch die Voransicht neu erstellt.
Dies kann/muss bei Verwendung einer Dokumentenverwaltung (wenn freigegeben) deaktiviert werden.
All dies geschieht in der Funktion
************
Function savejpg(w As Integer, h As Integer, dirName As String, name As String)
Dim window As View
Set window = ThisApplication.ActiveView
window.DisplayMode = kShadedRendering
window.ShowAmbientShadows = True
window.ShowGroundShadows = True
window.ShowObjectShadows = True

ThisApplication.ActiveView.GoHome
On Error Resume Next
ThisApplication.ActiveDocument.ObjectVisibility.AllWorkFeatures = False
On Error GoTo 0
window.Fit True
window.Update
ThisApplication.ActiveDocument.SetThumbnailSaveOption (kActiveComponentIsoViewOnSave)
ThisApplication.ActiveDocument.Save

Dim imageFilename As String
        'imageFilename = dirName & _
        '              Left$(name, InStr(name, ".")) & "jpg"
        imageFilename = dirName & name & ".jpg"
        Call window.SaveAsBitmap(imageFilename, w, h)
window.DisplayMode = kShadedWithEdgesRendering
End Function

------------------
************************************
 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Genial! Ich werde das Ganze gleich morgen ausprobieren und Rückmeldung geben! Danke schonmal!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Und ?

------------------
************************************
 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von Frank_Schalla:
Und ?

---

Konnte mich heute leider nicht damit beschäftigen. Die Arbeitswelt kann grausam sein 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

So !

Ich konnte das ganze testen, leider schmiert mein Inventor nach einigen Sekunden ab 

Ich werde versuchen mir die Perlen aus dem code raus zu picken ! Dabei lernt man auch gleich was !

Schönen Dank nochmal !

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP