mit nachstehendem Code (Aufruf durch ModuleErzeugen) versuche ich die Bytes einer beliebigen Binär-Datei in der Mappe selbst zu speichern.
Unerfülltes Endziel ist dann mittels "Put" die Bytes in eine Datei auf einem Fremdrechner zu schreiben und diese dann zu "starten"
Zweck des Ganzen, eine Excelmappe zu haben, die auf Fremdrechnern z.B. einen Flash ablaufen zu lassen und das ohne dabei seperat die dazu notwendige swf-Datei mit zu versenden.
Da, soweit ich weiß, die Modulgröße maximal 64KB beträgt, die Datei um die es geht aber 500KB erzeuge ich halt viele Moduel, die dann immer eine Prozedur nach diesem Muster haben:
Function Prog0() As String
Prog0 = Prog0 & Chr(67)
Prog0 = Prog0 & Chr(87)
Prog0 = Prog0 & Chr(83)
Prog0 = Prog0 & Chr(6)
Prog0 = Prog0 & Chr(10)
usw.
End Function
Jetzt habe ich erstens keinen genauen Plan wie ich in einer Schleife alle Prozeduren/Funktionen aufrufe um dann mit "Put" das Ergebniss immer an eine neue swf-Datei "anzuhängen".
Sehr erschwerend kommt dazu, mein Code läüft nur bis zum 422ten Modul, dann ist Schluß.
Welche Limitationen werden da verletzt?
pro Modul gibt es ca 1000 Einträge a 27 Bytes
also 27 KB
422 Module a 27 KB ergeben ca. 12000 KB
das ist keine mir bekannte Grenze!?
Danke für jeden Hinweis,Tipp,Lösung, wie ich das Problem lösen kann.
Ich habe auch schon probiert, jedes Byte der swf-datei in eine Zelle zu schreiben, diese Zellen dann auszulesen und in eine Datei zu schreiben, das klappt, ist aber grottenlangsam :-(
Gruß
Reinhard
Option Explicit
'Declare Sub CopyMemory Lib "kernel32.dll" _
' Alias "RtlMoveMemory" ( _
' Destination As Any, _
' Source As Any, _
' ByVal Length As Long)
Public txt As String, Block() As String, Anz As Integer
Sub ModuleErzeugen()
' Verweis auf Microsoft Visual basic for Applications Extensibility 5.3 setzen!
Dim N As Integer, NN As Long, vbComp As VBComponent, Zei As Long
Call ModuleLoeschen
'Exit Sub
Call tt
For N = 0 To UBound(Block)
Set vbComp = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule)
vbComp.Name = "mdlTeil" & N
With vbComp.CodeModule
.InsertLines .CountOfLines + 1, "Function Prog" & N & "() As String"
For NN = 1 To Len(Block(N))
.InsertLines .CountOfLines + 1, "Prog" & N & " = Prog" & N & " & Chr(" & Asc(Mid(Block( _
N), NN, 1)) & ")"
Next NN
.InsertLines .CountOfLines + 1, "End Function"
End With
Application.StatusBar = N & " / " & UBound(Block)
Next N
End Sub
Sub ModuleLoeschen()
Dim mdl As VBComponent
With ThisWorkbook.VBProject
For Each mdl In .VBComponents
If mdl.Name Like "mdlTeil*" Then .VBComponents.Remove mdl
Next mdl
End With
End Sub
Sub tt()
Dim Dat As String, FF As Long, Platz As Long
Dat = "H:\europeanchampionship2008\europeanchampionship2008.swf"
FF = FreeFile
Platz = FileLen(Dat)
Open Dat For Binary As #FF
txt = Input(Platz, #FF)
Close #FF
Call Teilen(txt, 1000)
End Sub
Sub Teilen(ByVal txt As String, Laenge As Long)
Dim N As Long, NN As Long
For N = 1 To Len(txt) Step Laenge
ReDim Preserve Block(Anz)
Block(Anz) = Mid(txt, N, Laenge)
Anz = Anz + 1
Next N
End Sub