PureDispHelper Userlib - Update Include für Unicode Support

[mk-soft]

UPDATE Variant Helper

Der DispHelper funktioniert soweit sehr Gut.

Es gibt aber Probleme Werte zu übergeben die nicht von Type LONG sind.
Der PB-Compiler für eine Formatumwandlung durch.
Es gibt leider keinen Type VOID oder ANY bei PB

Man kann aber die Parameter als Type Variant "%v" übergeben.

Hier die Hilfsfunktionen um mit Variant einfach arbeiten zu können
und ein Beispiel mit Excel.

Code: VariantHelper2.pb

Code: Alles auswählen

;-TOP
; Kommentar     : Variant Helper
; Author        : mk-soft
; Second Author : 
; Datei         : VariantHelper_Include.pb
; Version       : 2.03
; Erstellt      : 30.04.2007
; Geändert      :
; 
; Compilermode  :
;
; ***************************************************************************************

Define.l vhLastError

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

;- Structure SAFEARRAY
Structure SAFEARRAYBOUND
  cElements.l
  lLbound.l
EndStructure

Structure pData
  StructureUnion  
    bVal.b[0]; AS BYTE            ' VT_UI1
    iVal.w[0]; AS INTEGER         ' VT_I2
    lVal.l[0]; AS LONG            ' VT_I4
    llVal.q[0]; AS QUAD           ' VT_I8
    fltVal.f[0]; AS SINGLE        ' VT_R4
    dblVal.d[0]; AS DOUBLE        ' VT_R8
    boolVal.w[0]; AS INTEGER      ' VT_BOOL
    scode.l[0]; AS LONG           ' VT_ERROR
    cyVal.l[0]; AS LONG           ' VT_CY
    date.d[0]; AS DOUBLE          ' VT_DATE
    bstrVal.l[0]; AS LONG         ' VT_BSTR
    punkVal.l[0]; AS DWORD        ' VT_UNKNOWN
    pdispVal.l[0]; AS DWORD       ' VT_DISPATCH
    parray.l[0]; AS DWORD         ' VT_ARRAY|*
    Value.Variant[0];
  EndStructureUnion
EndStructure
  
Structure SAFEARRAY
  cDims.w
  fFeatures.w
  cbElements.l
  cLocks.l
  *pvData.pData
  rgsabound.SAFEARRAYBOUND[0]
EndStructure

; ***************************************************************************************
; UNICODE / ASCII Helper for SysAllocString
Procedure helpSysAllocString(*Value)
  ProcedureReturn SysAllocString_(*Value)
EndProcedure
Prototype.l ProtoSysAllocString(Value.p-unicode)
;-T_BSTR
Global T_BSTR.ProtoSysAllocString = @helpSysAllocString()

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

Procedure.d T_DATE(pbDate)
  
  Protected date.d
  
  date = pbDate / 86400.0 + 25569.0
  ProcedureReturn date
  
EndProcedure

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

Procedure.l vhGetLastError()

  Shared vhLastError
  
  ProcedureReturn vhLastError
  
EndProcedure

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

Procedure.s vhGetLastMessage()

  Shared vhLastError
  
  Protected *Buffer, len, result.s
  
  len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM,0,vhLastError,0,@*Buffer,0,0)
  If len
    result = PeekS(*Buffer, len - 2)
    LocalFree_(*Buffer)
    ProcedureReturn result
  Else
    ProcedureReturn "Errorcode: " + Hex(vhLastError)
  EndIf
  
EndProcedure

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

Procedure.s VT_STR(*Var.Variant)

  Shared vhLastError.l

  Protected vargDest.variant, hr, result.s
  
  If *Var
    hr = VariantChangeType_(vargDest, *Var, #LOCALE_NOUSEROVERRIDE, #VT_BSTR)
    If hr = #S_OK
      result = PeekS(vargDest\bstrVal, #PB_Any, #PB_Unicode)
      VariantClear_(vargDest)
      ProcedureReturn result
    
    Else
      vhLastError = hr
      ProcedureReturn ""
    EndIf
    
  EndIf
EndProcedure
  
; ***************************************************************************************
  
Procedure.l VT_BOOL(*Var.Variant)

  Shared vhLastError.l
  
  Protected result.l

  If *Var
    Select *Var\vt
      Case #VT_BOOL
        result = *Var\boolVal
      Case #VT_I1, #VT_UI1
        result = *Var\bVal
      Case #VT_I2, #VT_UI2
        result = *Var\iVal
      Case #VT_I4, #VT_UI4
        result = *Var\lVal
      Case #VT_I8, #VT_UI8
        result = *Var\llVal
      Case #VT_R4
        result = *Var\fltVal
      Case #VT_R8
         *Var\dblVal
      Default
        vhLastError = $80020008
        result = 0
    EndSelect
    If result
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.b VT_BYTE(*Var.Variant)

  Shared vhLastError.l
  
  If *Var
    Select *Var\vt
      Case #VT_BOOL
        ProcedureReturn *Var\boolVal
      Case #VT_I1, #VT_UI1
        ProcedureReturn *Var\bVal
      Case #VT_I2, #VT_UI2
        ProcedureReturn *Var\iVal
      Case #VT_I4, #VT_UI4
        ProcedureReturn *Var\lVal
      Case #VT_I8, #VT_UI8
        ProcedureReturn *Var\llVal
      Case #VT_R4
        ProcedureReturn *Var\fltVal
      Case #VT_R8
        ProcedureReturn *Var\dblVal
      Case #VT_BSTR
        ProcedureReturn Val(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
          
      Default
        vhLastError = $80020008
        ProcedureReturn 0
      
    EndSelect
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.w VT_WORD(*Var.Variant)

  Shared vhLastError.l
  
  If *Var
    Select *Var\vt
      Case #VT_BOOL
        ProcedureReturn *Var\boolVal
      Case #VT_I1, #VT_UI1
        ProcedureReturn *Var\bVal
      Case #VT_I2, #VT_UI2
        ProcedureReturn *Var\iVal
      Case #VT_I4, #VT_UI4
        ProcedureReturn *Var\lVal
      Case #VT_I8, #VT_UI8
        ProcedureReturn *Var\llVal
      Case #VT_R4
        ProcedureReturn *Var\fltVal
      Case #VT_R8
        ProcedureReturn *Var\dblVal
      Case #VT_BSTR
        ProcedureReturn Val(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
          
      Default
        vhLastError = $80020008
        ProcedureReturn 0
      
    EndSelect
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.l VT_LONG(*Var.Variant)

  Shared vhLastError.l
  
  If *Var
    Select *Var\vt
      Case #VT_BOOL
        ProcedureReturn *Var\boolVal
      Case #VT_I1, #VT_UI1
        ProcedureReturn *Var\bVal
      Case #VT_I2, #VT_UI2
        ProcedureReturn *Var\iVal
      Case #VT_I4, #VT_UI4
        ProcedureReturn *Var\lVal
      Case #VT_I8, #VT_UI8
        ProcedureReturn *Var\llVal
      Case #VT_R4
        ProcedureReturn *Var\fltVal
      Case #VT_R8
        ProcedureReturn *Var\dblVal
      Case #VT_BSTR
        ProcedureReturn Val(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
          
      Default
        vhLastError = $80020008
        ProcedureReturn 0
      
    EndSelect
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.q VT_QUAD(*Var.Variant)

  Shared vhLastError.l
  
  If *Var
    Select *Var\vt
      Case #VT_BOOL
        ProcedureReturn *Var\boolVal
      Case #VT_I1, #VT_UI1
        ProcedureReturn *Var\bVal
      Case #VT_I2, #VT_UI2
        ProcedureReturn *Var\iVal
      Case #VT_I4, #VT_UI4
        ProcedureReturn *Var\lVal
      Case #VT_I8, #VT_UI8
        ProcedureReturn *Var\llVal
      Case #VT_R4
        ProcedureReturn *Var\fltVal
      Case #VT_R8
        ProcedureReturn *Var\dblVal
      Case #VT_BSTR
        ProcedureReturn ValQ(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
          
      Default
        vhLastError = $80020008
        ProcedureReturn 0
      
    EndSelect
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.f VT_FLOAT(*Var.Variant)

  Shared vhLastError.l
  
  If *Var
    Select *Var\vt
      Case #VT_BOOL
        ProcedureReturn *Var\boolVal
      Case #VT_I1, #VT_UI1
        ProcedureReturn *Var\bVal
      Case #VT_I2, #VT_UI2
        ProcedureReturn *Var\iVal
      Case #VT_I4, #VT_UI4
        ProcedureReturn *Var\lVal
      Case #VT_I8, #VT_UI8
        ProcedureReturn *Var\llVal
      Case #VT_R4
        ProcedureReturn *Var\fltVal
      Case #VT_R8
        ProcedureReturn *Var\dblVal
      Case #VT_BSTR
        ProcedureReturn ValF(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
          
      Default
        vhLastError = $80020008
        ProcedureReturn 0
      
    EndSelect
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.d VT_DOUBLE(*Var.Variant)

  Shared vhLastError.l
  
  If *Var
    Select *Var\vt
      Case #VT_BOOL
        ProcedureReturn *Var\boolVal
      Case #VT_I1, #VT_UI1
        ProcedureReturn *Var\bVal
      Case #VT_I2, #VT_UI2
        ProcedureReturn *Var\iVal
      Case #VT_I4, #VT_UI4
        ProcedureReturn *Var\lVal
      Case #VT_I8, #VT_UI8
        ProcedureReturn *Var\llVal
      Case #VT_R4
        ProcedureReturn *Var\fltVal
      Case #VT_R8
        ProcedureReturn *Var\dblVal
      Case #VT_BSTR
        ProcedureReturn ValD(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
          
      Default
        vhLastError = $80020008
        ProcedureReturn 0
      
    EndSelect
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.l VT_DATE(*Var.Variant) ; PB-Datum

  Shared vhLastError.l
  
  Protected pbDate
  
  If *Var
    Select *Var\vt
      Case #VT_DATE
        pbDate = (*Var\dblVal  - 25569.0) * 86400.0
        ProcedureReturn pbDate
      Default
        vhLastError = $80020008
        ProcedureReturn 0
      
    EndSelect
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.l GetVariantSafeArrayCount(*Var.Variant)
  Protected result.l, *array.safearray
  If *Var
    If (*Var\vt & #VT_ARRAY) = #VT_ARRAY
      *array = *Var\parray
      result = *array\rgsabound\cElements
    Else
      result = 0
    EndIf
  Else
    result = 0
  EndIf
  ProcedureReturn result
EndProcedure

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

Procedure.l GetVariantSafeArrayVarType(*Var.Variant)
  Protected result.l, *array.safearray
  If *Var
    result = *Var\vt & $1FFF
  Else
    result = 0
  EndIf
  ProcedureReturn result
EndProcedure

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

Procedure.l GetVariantSafeArray(*Var.Variant)
  Protected result.l, *array.safearray
  If *Var
    If (*Var\vt & #VT_ARRAY) = #VT_ARRAY
      *array = *Var\parray
      result = *array\pvdata
    Else
      result = 0
    EndIf
  Else
    result = 0
  EndIf
  ProcedureReturn result
EndProcedure

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

Macro V_EMPTY(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_EMPTY
  arg\llVal = 0
EndMacro

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

Macro V_NULL(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_NULL
  arg\bstrVal
EndMacro

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

Macro V_DISP(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_DISPATCH
  arg\pdispVal
EndMacro

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

Macro V_UNKNOWN(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_UNKNOWN
  arg\punkVal
EndMacro

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

Macro V_STR(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BSTR
  arg\bstrVal
EndMacro

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

Macro V_BOOL(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BOOL
  arg\boolVal
EndMacro

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

Macro V_BYTE(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_I1
  arg\bVal
EndMacro

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

Macro V_UBYTE(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_UI1
  arg\bVal
EndMacro

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

Macro V_WORD(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_I2
  arg\iVal
EndMacro

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

Macro V_UWORD(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_UI2
  arg\iVal
EndMacro

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

Macro V_LONG(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_I4
  arg\lVal
EndMacro

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

Macro V_ULONG(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_UI4
  arg\lVal
EndMacro

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

Macro V_QUAD(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_I8
  arg\llVal
EndMacro

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

Macro V_FLOAT(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_R4
  arg\fltVal
EndMacro

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

Macro V_DOUBLE(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_R8
  arg\dblVal
EndMacro

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

Macro V_DATE(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_DATE
  arg\dblVal
EndMacro

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

Code: Excel.pb

Code: Alles auswählen

; example by Kiffi

EnableExplicit

IncludeFile "Varianthelper2.pb"

Define.l ExcelApp, Workbook

dhToggleExceptions(#True)

ExcelApp = dhCreateObject("Excel.Application")

Define.variant wert1, wert2, wert3, result, text

V_DOUBLE(wert1) = 3.33333333333333
V_DOUBLE(wert2) = 4.44444444444444
V_DOUBLE(wert3) = 5.55555555555555
V_STR(text) = T_BSTR("Hallo Welt")

If ExcelApp
  
  dhPutValue(ExcelApp, ".Visible = %b", #True)
  
  dhGetValue("%o", @Workbook, ExcelApp, ".Workbooks.Add")
  
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 1, @"Feel")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 2, 1, @"the")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 3, 1, @"pure")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 4, 1, @"Power")
  
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 2, @"the")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 3, @"pure")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 4, @"Power")

  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 2, 2, wert1)
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 2, 3, wert2)
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 2, 4, wert3)

  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 3, 2, text)

  dhGetValue("%v", @result, ExcelApp, "Cells(%d, %d).Value", 2, 2)

  MessageRequester("PureDispHelper-ExcelDemo", "Result Cells(2,2): " + VT_STR(result))

  MessageRequester("PureDispHelper-ExcelDemo", "Click OK to close Excel")
  
  dhCallMethod(ExcelApp, ".Quit")
  
  dhReleaseObject(Workbook) : Workbook = 0
  dhReleaseObject(ExcelApp) : ExcelApp = 0
  
Else
  
  MessageRequester("PureDispHelper-ExcelDemo", "Couldn't create Excel-Object")
  
EndIf

FF

[mk-soft]

Habe noch mal den Variant Helper erweitert.

VT_DATE(datum.Variant) gibt das Datum in PB-Datumsformat zurück
V_DATE(datum.Variant) = T_DATE(pbDate) setzt das Datum aus PB-datumsformat.

LastError und LastMessage Variablen sind nicht mehr Global.
Dafür zwei neue Funktionen zun auslesen.

-vhLastError()
-vhLastMessage()

FF

[ts-soft]

Sehr hilfreich, werde es beim nächstem Update hinzufügen!

//edit
done!

[mk-soft]

Excel Beispiel für DispHelper_Include

Code: Excel2.pb

Code: Alles auswählen

; example by Kiffi and mk-soft


IncludeFile "DispHelper_Include.pb"
IncludeFile "VariantHelper2.pb"

EnableExplicit

Define.l ExcelApp, Workbook

dhInitializeImp()
dhToggleExceptions(#True)

ExcelApp = dhCreateObject("Excel.Application")

Define.variant wert1, wert2, wert3, result, text, datum

V_DOUBLE(wert1) = 3.33333333333333
V_DOUBLE(wert2) = 4.44444444444444
V_DOUBLE(wert3) = 5.55555555555555
V_STR(text) = T_BSTR("Hallo Welt")
V_DATE(datum) = T_DATE(Date())

If ExcelApp
  
  dhPutValue(ExcelApp, ".Visible = %b", #True)
  
  dhGetValue("%o", @Workbook, ExcelApp, ".Workbooks.Add")
  
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 1, 1, @"Feel")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 2, 1, @"the")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 3, 1, @"pure")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 4, 1, @"Power")
  
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 1, 2, @"the")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 1, 3, @"pure")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 1, 4, @"Power")

  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 2, 2, wert1)
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 2, 3, wert2)
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 2, 4, wert3)

  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 3, 2, text)
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 4, 2, datum)

  dhGetValue("%v", @result, ExcelApp, "Cells(%d, %d).Value", 2, 2)

  MessageRequester("PureDispHelper-ExcelDemo", "Result Cells(2,2): " + VT_STR(result))

  MessageRequester("PureDispHelper-ExcelDemo", "Click OK to close Excel")
  
  dhCallMethod(ExcelApp, ".Quit")
  
  dhReleaseObject(Workbook) : Workbook = 0
  dhReleaseObject(ExcelApp) : ExcelApp = 0
  
Else
  
  MessageRequester("PureDispHelper-ExcelDemo", "Couldn't create Excel-Object")
  
EndIf

FF

P.S. VariantHelper2.pb auf Seite 4

[gekkonier]

Hallo, erstmal vielen Dank für diese wunderbare Lib!

Ich hätte eine kleine Frage zur Benutzung dieser:

Und zwar würde ich damit gerne Word-Vorlagen (.dot) Daten mit documents.add verwenden. Dabei soll nicht die dot direkt geöffnet werden, sondern als Vorlagendatei verwendet werden (also wie Neu -> aus Vorlage..)

In Ruby sieht das ca. so aus:

Code: Alles auswählen

require "win32ole"
word = WIN32OLE.new('Word.Application')
word.documents.add(File.expand_path("meinevorlage.dot"))
word.Visible = 1

Weiss jemand, wie ich das mit PB4 machen kann?

Vielen Dank, Gekkonier

[gekkonier]

Okidoki!

Bin selber draufgekommen, hier derselbe Code von Ruby auf PB übersetzt:

Code: Alles auswählen

oWord.l = dhCreateObject("Word.Application")
dhPutValue (oWord, "Visible = %b", #True)

; Documents.Add erwartet den vollen Pfad
; hier befindet sich die Date vorlage.dot im selben Pfad wie das Programm
filename.s = GetCurrentDirectory() + "vorlage.dot"
dhCallMethod (oWord, "Documents.Add(%s)", @filename)

dhReleaseObject (oWord)
oWord = 0

Nochmals danke für diese tolle Lib, so etwas hat PB gefehlt!

[ts-soft]

Neuigkeiten immer im engl. Forum:
http://www.purebasic.fr/english/viewtopic.php?t=26744
Hab keine Lust alles 2x zu posten und hier hält sich das Interesse ja in Grenzen

Über den Download link erhaltet ihr immer die aktuelle Version!

Gruß
Thomas

[ts-soft]

Grosses Upate auf Version 1.3

Die UserLib wird nicht mehr supported, ist aber weiterhin im Paket enthalten.

Der C-Source von Disphelper wurde angepaßt, um grössere Kompatibilität
zu PureBasic zu erreichen (dank an mk-soft )

Die libgcc.lib wurde entfernt, disphelper.lib jetzt mit PellesC kompiliert
(SourcePackage liegt bei)

Neu Identifier hinzugefügt:
Volle Unterstützung von Double, Float, Word usw.

Doku für PureBasic spezifiesche Änderungen im PDF-Format beigefügt.

Neuer VariantHelper, unterstützt jetzt auch Variant-Arrays.

Diverse Bugs beseitigt.

Gruß
Thomas

[Falko]

@kiffi,
ich steig leider durch den VBA-Excel-Objectkram nicht so richtig durch. Vorallem, wann man was nehmen muss und vorallem, wie man es in PB dann umsetzt.

Ich suche was um z.B. eine Zelle aus einer bestehenden Exceldatei auszulesen, diese nach Überprüfung dann zu ersetzen oder zu löschen und
dann wieder die Exceldatei zu schließen.

Hättest du dafür ein kleines Beispiel für mich?

Im Vorraus schon mal danke

Gruß Falko

[Kiffi]

Hättest du dafür ein kleines Beispiel für mich?

klar

als erstes musst Du die entsprechende Excel-Datei laden

Code: Alles auswählen

dhCallMethod(ExcelApp, ".Workbooks.Open(%T)", @DeineXls$)

danach kannst Du den Inhalt der Zelle auslesen:

Code: Alles auswählen

dhGetValue("%T", @ReturnValue, ExcelApp, "Cells(%d, %d).Value", 1, 1)

(wobei anzumerken ist, dass es einen Unterschied zwischen dem
angezeigten Inhalt (Cells().Text) und die dahinterliegende Formel
(Cells().Value) geben kann.)

Nun kannst Du ReturnValue auswerten.

Danach schreibst Du den neuen Wert in die Zelle:

Code: Alles auswählen

dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 1, 1, @NewValue)

That's it! Den Rest kennste ja. Obiger Beispielcode gilt allerdings nur
für das aktive WorkBook und das aktive WorkSheet. Willst Du da was
anderes haben, dann sag kurz Bescheid.

Grüße ... Kiffi