|
Hallo,
ich habe eine komplexe Excel-Anwendung zur Bilanzanalyse, die leider "von oben" nicht mehr gepflegt wird.
Aber es gibt viele Leute "an der Basis" die darauf angewiesen sind.
Sie läuft problemlos auf Office-32-bit-Systemen, die aber kaum mehr einer hat.
Bei 64 bit kommt folgende Fehlermeldung:
"Fehler beim Kompilieren
Der Code in diesem Projekt muß für die Verwendung auf 64-Bit-Systemen aktualisiert werden.
Überarbeiten und aktualisieren Sie Declare-Anweisungen und markieren Sie sie mit dem PtrSafe-Attribut."
Nun ist meine Hoffnung, daß vielleicht nur wenige Wörtchen ausgetauscht werden müssen und einer von Euch Freaks das erkennt.
Hier der VBA-Code:
Declare Function GetPrivateProfileStringA Lib "kernel32" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) _
As Long
Public FilePC1182ini As String
Public CurrentProfile As String
Public pfadtba As String
Public XP As Boolean
Dim StrDatenQuelle As String ' Name der Datei mit den Daten (absoluter Pfad)
Public BIT32 As Boolean ' handelt es sich um ein 32bit-System
Sub OSTest()
pfadtba = "c:\Program Files (x86)" ' Unterscheidungsmerkmal zwischen Windows XP und höheren Versionen
pfadtba = Dir(pfadtba, vbDirectory)
If pfadtba = "" Then
XP = True
Else
XP = False
End If
End Sub
Sub Oeffnen_spool()
Dim Zahl As Integer
Dim BS As String
Dim EXCEL_Version As String
Dim Msg As String
Dim Version
Dim BenVer
Dim mm
Dim IniFile As String
Dim ix, iy
Dim myFenster
Dim intRc As Integer
Application.ScreenUpdating = False
'On Error GoTo Fehlerbehandlung ' Fehlerbehandlungsroutine aktivieren.
Rem anhand der EXCEL-Versionsnummer wird festgestellt ob es ein 32bit oder ein 16bit EXCEL ist
Rem EXCEL 5.x ist noch 16bit alles darüber ist bereits 32bit und benötigt dann entsprechend die 32bit DLL's
Rem Über z.B Application.OperatingSystem kann man nicht prüfen da es sein kann, daß
Rem auf einem 32BIT WINDOWS95 ein 16bit EXCEL läuft
CurrentProfile = Environ$("USERPROFILE")
FilePC1182ini = CurrentProfile & "\Appdata\Local\Virtualstore\Windows\PC1182$.ini" ' Unter Windows 7 wird Ablage für die PC1182$.ini von C:\Windows in das aktuelle Userprofil umgeleitet
IniFile = "PC1182$.INI"
Call OSTest
'BS = Application.Version
'EXCEL_Version = Mid$(BS, 1, 2)
'Zahl = Val(EXCEL_Version)
'If Zahl > 5 Then
' BIT32 = True
Rem MsgBox "Es ist ein 32bit-System" & Zahl
'Else
' BIT32 = False
Rem MsgBox "Es ist kein 32bit-System" & Zahl
'End If
Rem Datei Pc1182.ini; i.d.R im Windows-Standardverzeichnis C:\NETWARE\WIN31\, bzw in NT in C:\WINNT
Rem Version ist die Versionsnummer des EXCEL-Makros
Version = 1
Rem Msg ist bis jetzt nur ein Pointer; hiermit wird jetzt Speicherplatz allokiert
Msg = Space(255)
'If BIT32 Then
' intRc = GetPrivateProfileString32("EXCEL", "MSG", " ", Msg, 255, IniFile)
'Else
' intRc = GetPrivateProfileString("EXCEL", "MSG", " ", Msg, 255, IniFile)
'End If
If XP Then
intRc = GetPrivateProfileStringA("EXCEL", "MSG", " ", Msg, 255, IniFile)
Else
intRc = GetPrivateProfileStringA("EXCEL", "MSG", " ", Msg, 255, FilePC1182ini)
' --- Windows 7 Kompatibilität
End If
Rem MsgBox "In der INI-Datei wurde folgender Eintrag gefunden:" & Msg
Rem Makroversion mit benötigter Version vergleichen + Fehlerhandlingix = InStr(Msg, "VER=")
If ix = 0 Then
' GeheZu endmain
End If
mm = Mid$(Msg, ix + 4)
iy = InStr(mm, " ")
If iy <> 0 Then
mm = Mid$(mm, 1, iy - 1)
End If
BenVer = Val(mm)
If BenVer <> Version Then
' GeheZu endmain
End If
ix = InStr(Msg, "DATEN=")
If ix = 0 Then
' GeheZu endmain
End If
mm = Mid$(Msg, ix + 6)
iy = InStr(mm, " ")
If iy <> 0 Then
mm = Mid$(mm, 1, iy - 1)
End If
StrDatenQuelle = mm
Workbooks.Open Filename:="JA_AUSDR.XLS", ReadOnly:=True, UpdateLinks:=0
Workbooks.Open Filename:="AUTOEING.XLS", ReadOnly:=True, UpdateLinks:=0
Workbooks.Open Filename:="BILANZH.XLS", ReadOnly:=True, UpdateLinks:=0
' Workbooks.Open Filename:="OEKON_B.XLS", ReadOnly:=True, UpdateLinks:=0
' auskommentiert 9.11.04, Datenübernahme entfällt, Wi.
Statsatz_spool
Windows("JA_BILAN.XLS").Activate
End Sub
'
Sub Statsatz_spool()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Windows("JA_BILAN.XLS").Activate
Sheets("Tabelle1").Select
Columns("A:L").Select
Selection.ClearContents
Sheets("Tabelle3").Select
Workbooks.OpenText Filename:=StrDatenQuelle, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=True, Comma:=False, Space:= _
False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1))
Löschen_Zeilen
Columns("A:L").Select
Selection.Copy
Windows("JA_BILAN.XLS").Activate
Sheets("Tabelle1").Select
Columns("A:L").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
ActiveWindow.Close
Makro13
End Sub
|