Ein Makro aus Notes einpflanzen geht so nicht.
Das ist so nicht ganz korrekt.
Über das VBProject.VBComponents Objekt kann man der Arbeitsmappe Module hinzufügen und darin Prozeduren erstellen.
Das ist zwar etwas kompliziert, wenn man das Script der Prozedur zur Laufzeit des Notes Scriptes berechnen muss aber es ist machbar.
Leider gibt es eine Sicherheitseinstellung, die in Excel eingestellt sein MUSS:
- Über das Menü "Extras\Marko\Sicherheit" die Sichereitseinstellungen aufrufen.
- Auf dem Reiter "Vertrauenswürdige Quelle die Option "Zugriff auf das Visual-Basic Projekt vertrauen" aktivieren
Ich hab noch nicht herausgefunden, wie man diese Einstellung (wenigstens) abfragen kann.
Hier ein Beispiel-Agent:
Es wird eine Tabelle aufgebaut: 2 Spalten und 3 Datensätze.
Danach wird über den Spaltentiteln pro Spalte ein Sortier-Flipp-Flopp Button erstellt, der einen von LS erstellten Makro aufruft.
Es gibt natürlich auch einfachere Beispiele, aber nur mal um so zu zeigen was möglich ist.
Sub Initialize
Dim int_row As Integer
Dim var_columns As Variant
Dim var_row As Variant
Dim xl_app As Variant
Dim xl_books As Variant
Dim xl_book As Variant
Dim xl_sheet As Variant
Dim xl_columns As Variant
Dim xl_row As Variant
' ### table ###
' create worksheet
Set xl_app = CreateObject("Excel.Application")
Set xl_books = xl_app.Workbooks
Set xl_book = xl_books.Add()
Set xl_sheet = xl_book.Worksheets(1)
xl_app.Visible = True
Stop
' column titles (second row of the worksheet)
Set xl_columns = xl_sheet.Range(xl_sheet.Cells(2, 1), xl_sheet.Cells(2, 2))
var_columns = xl_columns.Value
var_columns(1, 1) = "Spalte 1"
var_columns(1, 2) = "Spalte 2"
xl_columns.Value = var_columns
' add tree rows below columns range
For int_row = 1 To 3
If Isempty(xl_row) Then Set xl_row = xl_columns.Rows(2) Else Set xl_row = xl_row.Rows(2)
var_row = xl_row.Value
var_row(1, 1) = "Zeile " & int_row
var_row(1, 2) = Rnd()
xl_row.Value = var_row
Next
' ### sort buttons ###
Dim int_column As Integer
Dim xl_columndata As Variant
Dim xl_module As Variant
Dim str_script As String
Dim str_address As String
Dim str_keyaddress As String
Dim dbl_left As Double
Dim dbl_top As Double
Dim dbl_width As Double
Dim dbl_height As Double
' add an new module into the workbook
Set xl_module = CreateModule(xl_book)
xl_module.Name = "SortButtons"
' declarations
Call CreateSub(xl_module,"Option Base 1") ' lower bound of all arrays is 1
Call CreateSub(xl_module,"Dim int_order(" & xl_columns.Columns.Count & ") As Integer") ' current sort order of each button
' add the sort script for each column
For int_column = 1 To xl_columns.Columns.Count
' range to sort
Set xl_columndata = xl_sheet.Range(xl_columns.Rows(2).Cells(int_column), xl_row.Cells(int_column))
' build script
str_script = "Sub Sort" & int_column & Chr(13) & _
" If int_order(" & int_column & ") = xlAscending Then" & Chr(13) & _
" int_order(" & int_column & ") = xlDescending" & Chr(13) & _
" Else" & Chr(13) & _
" int_order(" & int_column & ") = xlAscending" & Chr(13) & _
" End If" & Chr(13) & _
" ActiveSheet.Range(""" & xl_columndata.Address & """).Sort" & _
" Key1:=Range(""" & xl_columndata.Cells(1).Address & """)" & _
", Order1:=int_order(" & int_column & ")" & _
", Header:=xlNo " & _
", OrderCustom:=1" & _
", MatchCase:=False" & _
", Orientation:=xlTopToBottom" & _
", DataOption1:=xlSortNormal" & Chr(13) & _
"End Sub"
' add script
Call CreateSub(xl_module,str_script)
' create sort button
dbl_left = xl_sheet.Cells(xl_columns.Row - 1, int_column).Left
dbl_top = xl_sheet.Cells(xl_columns.Row - 1, int_column).Top
dbl_width = xl_sheet.Cells(xl_columns.Row - 1, int_column).Width
dbl_height = xl_sheet.Cells(xl_columns.Row - 1, int_column).Height
Call CreateButton(dbl_left, dbl_top, dbl_width, dbl_height, xl_sheet, Chr(118), "Sort" & int_column)
Next int_column
End Sub
Function CreateModule(book As Variant) As Variant
%REM
erstellt am: 10.03.2004
erstellt von: Stefan Johannsen
Function CreateModule(book As Variant) As Variant
Erstellt ein neues Modul in der Arbeitsmappe und gibt es zurück.
%END REM
Dim vbproject As Variant
Dim vbcomponents As Variant
Const vbext_ct_StdModule = 1
Set vbproject = book.VBProject
Set vbcomponents = vbproject.VBComponents
Set CreateModule = vbcomponents.Add(vbext_ct_StdModule)
End Function
Sub CreateSub(module As Variant,str_script As String)
%REM
erstellt am: 10.03.2004
erstellt von: Stefan Johannsen
Sub CreateSub(module As Variant,str_script As String)
Fügt in das übergebene Modul einen Text ein.
s. Sub ReadMe
%END REM
Dim codemodule As Variant
Set codemodule = module.CodeModule
Call codemodule.InsertLines(codemodule.CountOfLines+1,str_script)
End Sub
Function CreateButton(dbl_left As Double, dbl_top As Double, dbl_width As Double, dbl_height As Double, sheet As Variant, str_caption As String,str_scriptname As String) As Variant
Const xlAutomatic = -4105
Const xlUnderlineStyleNone = -4142
sheet.Buttons.Add(dbl_left,dbl_top,dbl_width,dbl_height).Select
sheet.Application.Selection.Characters.Text = str_caption
With sheet.Application.Selection.Characters(1,9).Font
.Name = "Marlett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
sheet.Application.Selection.OnAction = str_scriptname
End Function
[/list]
Thema: Notes to Excel Export und sortieren (Gelesen 4048 mal)