Aktuelle Zeit: 22.10.2018 13:46

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 13 Beiträge ]  Gehe zu Seite Vorherige  1, 2
Autor Nachricht
 Betreff des Beitrags: Re: Mit ComatePlus Image im Word-Header platzieren
BeitragVerfasst: 18.09.2018 18:57 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
Hi Meier,

Wenn es mit VBA geht, geht es vielleicht auch mit VBScript.
Ich habe mein Modul 'ActiveScript' in der Beta Version schon gut am laufen.
In diesen kann man die Runtime Variablen von Purebasic verwenden und mit den AddOn 'SmartTags' Variablen von Type Variant austauschen.

Einfach ein Script schreiben und aufrufen.

Hier mal ein Anfang. (Update)
Code:
;-TOP

; Comment   : Modul ActiveScipt Example 1

; Link to ActiveScript  : https://www.purebasic.fr/english/viewtopic.php?f=12&t=71399
; Link to VariantHelper : https://www.purebasic.fr/english/viewtopic.php?f=14&t=40150

; ***************************************************************************************

XIncludeFile "Modul_ActiveScript.pb"
XIncludeFile "Modul_SmartTags.pb"
XIncludeFile "VariantHelper_Include.pb"

UseModule ActiveScript
UseModule ActiveSmartTags

; -------------------------------------------------------------------------------------

Procedure ArrayToSafeArray(Array Strings.s(1), LBound = 0)
  Protected rgsabound.SAFEARRAYBOUND, *psa.SAFEARRAY, Index, UBound
 
  UBound = ArraySize(Strings())
  rgsabound\lLbound = LBound
  rgsabound\cElements = UBound + 1
 
  *psa = SafeArrayCreate_(#VT_VARIANT, 1, rgsabound)
  If *psa
    For Index = 0 To UBound
      *psa\pvData\Value[Index]\vt = #VT_BSTR
      *psa\pvData\Value[Index]\bstrVal = T_BSTR(Strings(Index))
    Next
    ProcedureReturn *psa
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

; -------------------------------------------------------------------------------------

Procedure ListToSafeArray(List Strings.s(), LBound = 0)
  Protected rgsabound.SAFEARRAYBOUND, *psa.SAFEARRAY, Index, Size
 
  Size = ListSize(Strings())
  If Size
    rgsabound\lLbound = LBound
    rgsabound\cElements = Size
   
    *psa = SafeArrayCreate_(#VT_VARIANT, 1, rgsabound)
    If *psa
      index = 0
      ForEach Strings()
        *psa\pvData\Value[Index]\vt = #VT_BSTR
        *psa\pvData\Value[Index]\bstrVal = T_BSTR(Strings())
        index + 1
      Next
      ProcedureReturn *psa
    Else
      ProcedureReturn 0
    EndIf
  Else
    ProcedureReturn 0
  EndIf
 
EndProcedure

; -------------------------------------------------------------------------------------

Procedure SafeArrayToVariant(*Var.Variant, *SafeArray.SAFEARRAY)
  If *Var And *SafeArray
    *Var\vt = #VT_ARRAY | #VT_VARIANT
    *Var\parray = *SafeArray
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

; -------------------------------------------------------------------------------------

Global vbs.s, name.s, *psa_files, *psa_text
Global Dim files.s(3)
Global NewList Text.s()

; Varible als Rumtime definieren zum Zugriff aus VB-Script
Runtime name

; Daten anlegen
name = "test.xls"
files(0) = "Image-1.jpg"
files(1) = "Image-2.jpg"
files(2) = "Image-3.jpg"
files(3) = "Image-4.jpg"

AddElement(Text()) : Text() = "Hello World"
AddElement(Text()) : Text() = "I like Purebasic"

; Das Array in ein SafeArray wandeln
*psa_files = ArrayToSafeArray(files())
; Das SafeArray zum SmartTag zuweisen
SafeArrayToVariant(SmartTags("files"), *psa_files)

; Die Liste in ein SafeArray wandeln
*psa_text = ListToSafeArray(Text())
; Das SafeArray zum SmartTag zuweisen
SafeArrayToVariant(SmartTags("texte"), *psa_text)

; VB-Script schreiben
vbs + "Dim name, file, files, texte, result" + #LF$
vbs + "" + #LF$
vbs + "name = Runtime.String('name')" + #LF$
vbs + "result = 'Name: ' & name & vbNewLine" + #LF$
vbs + "" + #LF$
vbs + "files = SmartTags('files')" + #LF$
vbs + "texte = SmartTags('texte')" + #LF$
vbs + "" + #LF$
vbs + "result = result & vbNewline & 'Array:' & vbNewline" + #LF$
vbs + "If IsArray(files) Then" + #LF$
vbs + "  For Each file In Files" + #LF$
vbs + "    result = result & file & vbNewLine" + #LF$
vbs + "   Next" + #LF$
vbs + "Else" + #LF$
vbs + "  result = 'No Array'" + #LF$
vbs + "End If" + #LF$
vbs + "" + #LF$
vbs + "result = result & vbNewline & 'List:' & vbNewline" + #LF$
vbs + "If IsArray(texte) Then" + #LF$
vbs + "  result = result & texte(0) & vbNewLine" + #LF$
vbs + "  result = result & texte(1) & vbNewLine" + #LF$
vbs + "Else" + #LF$
vbs + "  result = 'No Array'" + #LF$
vbs + "End If" + #LF$
vbs + "" + #LF$
vbs + "MsgBox result" + #LF$
vbs + "" + #LF$

vbs = ReplaceString(vbs, "'", #DQUOTE$)

; VB-Script ausführen
If NewActiveScript()
  AddObject("SmartTags", NewSmartTags())
  Debug "**********************************"
  Debug vbs
  Debug "**********************************"
  ParseScriptText(vbs)
  Debug "**********************************"
  FreeActiveScript()
EndIf

_________________
Alles ist möglich, fragt sich nur wie...
Projekte EventDesigner v1.x / OOP-BaseClass-Modul / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mit ComatePlus Image im Word-Header platzieren
BeitragVerfasst: 23.09.2018 08:37 
Offline

Registriert: 18.01.2018 17:02
Hallo mk-soft,

danke für deinen Ansatz. Ich werde es gleich ausprobieren, wenn ich wieder da bin. Bin zur Zeit nur mit Smartphone bewaffnet außer Landes.

@Peter: Ich habe gesehen, dass du auch tolle Lösungen mit XML-Dateien + ComatePlus gepostet hast. Vielleicht wäre das ein weiterer Ansatz?

Viele Grüße
Meier


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mit ComatePlus Image im Word-Header platzieren
BeitragVerfasst: 08.10.2018 11:21 
Offline

Registriert: 18.01.2018 17:02
Hallo zusammen,

@mk-soft: Ich habe es mir angesehen, aber so ganz haben Anpassungen bei mir noch nicht funktioniert...

Dann bin ich aber über die Lösung zu dem Ansatz von Peter gestolpert... :bounce:

Ich muss nicht in die nächste Zeile, sondern in die untere Zelle. Denn drumherum ist eine Tabelle, bei der die Linien weggemacht wurden.

Ich muss also das Tabellen-Objekt behandeln. Und dann war es ganz einfach.

Hier der Ansatz von Peter mit meinen Änderungen:

Code:
XIncludeFile "../COMatePLUS.pbi"

EnableExplicit

Procedure InsertImageToWordHeader(WordFilename.s, ImageFilename.s)
 
  Protected oWordApplication.COMateObject
  Protected oActiveDocument.COMateObject
  Protected oSection.COMateObject
  Protected oHeader.COMateObject
  Protected oRange.COMateObject
  Protected oRange2.COMateObject
  Protected oTable.COMateObject
 
 
  Debug "CreateObject"
  oWordApplication = COMate_CreateObject("Word.Application")
  Debug COMate_GetLastErrorDescription()
 
  If oWordApplication
   
    Debug "Application.Visible=#True"
    oWordApplication\SetProperty("Application\Visible=#True")
    Debug COMate_GetLastErrorDescription()
   
    ; Open the document.
    Debug "Documents\Open"
    oWordApplication\Invoke("Documents\Open('" + WordFilename + "')")
    Debug COMate_GetLastErrorDescription()
   
    ; ####
   
    Debug "oActiveDocument"
    oActiveDocument = oWordApplication\GetObjectProperty("ActiveDocument")
    Debug COMate_GetLastErrorDescription()
   
    If oActiveDocument
     
      Debug "oSection..."
      oSection = oActiveDocument\GetObjectProperty("Sections(1)")
      Debug COMate_GetLastErrorDescription()
     
      If oSection
       
        Debug "oHeader..."
        oHeader = oSection\GetObjectProperty("Headers(1)") ; 1 = wdHeaderFooterPrimary
        Debug COMate_GetLastErrorDescription()
       
        If oHeader
       
          Debug "oRange..."
          oRange = oHeader\GetObjectProperty("Range")
          Debug COMate_GetLastErrorDescription()
         
          If oRange
           
            Debug "oTable..."
            oTable = oRange\GetObjectProperty("Tables(1)")
            Debug COMate_GetLastErrorDescription()
           
            If oTable
             
              Debug "oRange2"
              oRange2 = otable\GetObjectProperty("Cell(2,1)\Range")
              Debug COMate_GetLastErrorDescription()
             
              If oRange2
               
                Debug "AddPicture..."
                oRange2\Invoke("InlineShapes\AddPicture('" + ImageFilename + "')")
                Debug COMate_GetLastErrorDescription()
               
                oRange2\Release()
              Else
                Debug "!oRange2"
              EndIf
              oTable\Release()
            Else
              Debug "!oTable"
            EndIf
            oRange\Release()
          Else
            Debug "!oRange"
          EndIf
          oHeader\Release()
        Else
          Debug "!oHeader"
        EndIf
        oSection\Release()
      Else
        Debug "!oSection"
      EndIf
      oActiveDocument\Release()
    Else
      Debug "!oActiveDocument"
    EndIf
   
    oWordApplication\Release()
   
    Debug "Ready!"
   
  Else
   
    Debug "Failed to create application object."
    Debug COMate_GetLastErrorDescription()
   
  EndIf
 
EndProcedure

InsertImageToWordHeader("D:\test.xml", "D:\test.jpg")




Vielen Dank euch beiden und viele Grüße

Meier


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 13 Beiträge ]  Gehe zu Seite Vorherige  1, 2

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 2 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye