Office: VBA-Code kompilieren

Thomas_Engel · 21. September 2003

Guten Morgen,

ich habe hier ein Programm, das in VB geschrieben wurde. Dieses greift auf eine Access-Datenbank zu. Darin gibt es Berichte mit VBA-Code im Drucken-Ereignis. Nun läuft das einigermassen langsam und ich vermute, das liegt daran, dass der VBA-Code jedesmal zur Laufzeit zuerst kompiliert werden muss.
Gibt es eine Möglichkeit, diesen VBA-Code in das kompilierte VB-Programm zu übernehmen, damit das schneller läuft?

Danke schon mal
Thomas

:)

Thomas Braun · 22. September 2003

Du kannst in der Entwurfsansicht des Bericht in den Code gehen und den Menüpunkt "Testen --> Alle Module kompilieren und speichern" (Access97) auswählen. Bei den anderen Access Versionen heißt der Punkt "Debuggen" oder so.

Ich schätze aber, dass die Geschwindigkeit eher mit der zugrundeliegenden Abfrage zu tun hat. Wie sieht der VBA-Code denn aus?

Thomas_Engel · 22. September 2003

Hi Thomas,

das Debuggen wird nicht viel bringen, weil der Code ja funktioniert. Es ist einfach für meinen Geschmack zu langsam. Das liegt eben vermutlich daran, weil der Code bei jedem Ausführen neu kompiliert wird. Wäre der Code in meiner EXE-Datei, dann wäre er eben schon kompiliert. Ich habe auch schon versucht, die mdb in eine mde umzuwandeln. Das bringt aber auch keine Geschwindigkeit.
Hier jedenfalls mal der Code:

Das ist der Code im Bericht:
Code:

Option Compare Database
Option Explicit

Private Sub Detailbereich_A_Print(Cancel As Integer, PrintCount As Integer)
On Error GoTo Fehler
Const TWIPS = 1

'Variablen um Einstellungen zu sichern
Dim oldFontBold As Integer
Dim oldFontItalic As Integer
Dim oldForeColor As Long
Dim oldFontName As String
Dim oldfontsize As Integer
Dim oldScaleMode As Integer

'Temporäre Variablear
Dim lngRet As Long

'Einstellungen sichern
With Me
oldFontItalic = .FontItalic
oldFontBold = .FontBold
oldForeColor = .ForeColor
oldFontName = .FontName
oldfontsize = .FontSize
oldScaleMode = .ScaleMode
End With

'Felder unsichtbar machen
[Menge-D].Visible = False
[Einzelpreis-D].Visible = False
[Summe-D].Visible = False

'Prüfen, ob Menge = 0
If [Menge-D] = 0 Then GoTo Ende

With Me
'Auf Twips umstellen
.ScaleMode = TWIPS

'----- Hier die Menge -----
'Schriftart und Grösse übernehmen
.FontName = [Menge-D].FontName
.FontSize = [Menge-D].FontSize

'gewünschte Einstellungen erstellen
Me.FontBold = IIf((Me.[Menge-D].FontBold) 0, -1, 0)
.FontItalic = [Menge-D].FontItalic
.ForeColor = [Menge-D].ForeColor

'TextMetrics
lngRet = fTextMetric(Me.[Bezeichnung-D])

If Me.[Bezeichnung-D].Height > Me.[Menge-D].Height Then
.CurrentY = Me.[Bezeichnung-D].Top + Me.[Bezeichnung-D].Height
.CurrentY = CurrentY - (sTM.tmHeight)
Else
.CurrentY = Me.[Menge-D].Top + sTM.tmInternalLeading

End If

.CurrentX = .[Menge-D].Left + _
.[Menge-D].Width - _
TextWidth(.[Menge-D])
Me.Print Me.[Menge-D]

'Prüfen, ob Einzelpreis = 0
If [Einzelpreis-D] = 0 Then GoTo Ende

'----- Hier der Einzelpreis -----
'Schriftart und Grösse übernehmen
.FontName = [Einzelpreis-D].FontName
.FontSize = [Einzelpreis-D].FontSize

'gewünschte Einstellungen erstellen
Me.FontBold = IIf((Me.[Einzelpreis-D].FontBold) 0, -1, 0)
.FontItalic = [Einzelpreis-D].FontItalic
.ForeColor = [Einzelpreis-D].ForeColor

'TextMetrics
lngRet = fTextMetric(Me.[Bezeichnung-D])

If Me.[Bezeichnung-D].Height > Me.[Einzelpreis-D].Height Then
.CurrentY = Me.[Bezeichnung-D].Top + Me.[Bezeichnung-D].Height
.CurrentY = CurrentY - (sTM.tmHeight)
Else
.CurrentY = Me.[Einzelpreis-D].Top + sTM.tmInternalLeading

End If
.CurrentX = .[Einzelpreis-D].Left + _
.[Einzelpreis-D].Width - _
TextWidth(Format(.[Einzelpreis-D], "#,##0.00"))
Me.Print Format(Me.[Einzelpreis-D], "#,##0.00")

'----- Hier die Summe -----
'Schriftart und Grösse übernehmen
.FontName = [Summe-D].FontName
.FontSize = [Summe-D].FontSize

'gewünschte Einstellungen erstellen
Me.FontBold = IIf((Me.[Summe-D].FontBold) 0, -1, 0)
.FontItalic = [Summe-D].FontItalic
.ForeColor = [Summe-D].ForeColor

'TextMetrics
lngRet = fTextMetric(Me.[Summe-D])

If Me.[Bezeichnung-D].Height > Me.[Summe-D].Height Then
.CurrentY = Me.[Bezeichnung-D].Top + Me.[Bezeichnung-D].Height
.CurrentY = CurrentY - (sTM.tmHeight)
Else
.CurrentY = Me.[Summe-D].Top + sTM.tmInternalLeading

End If

.CurrentX = .[Summe-D].Left + _
.[Summe-D].Width - _
TextWidth(Format(.[Summe-D], "#,##0.00"))
Me.Print Format(Me.[Summe-D], "#,##0.00")

Ende:
'alte Einstellungen wieder herstellen
.ScaleMode = oldScaleMode
.FontBold = oldFontBold
.FontItalic = oldFontItalic
.FontName = oldFontName
.FontSize = oldfontsize
.ForeColor = oldForeColor

End With
Exit Sub
Fehler:
Select Case Err.Number
Case Is = 94
Exit Sub
End Select
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das ist der Code von Mudul1
Code:

Option Compare Database

Option Explicit

'Hier wird ein Objekttyp definiert, der alle Angaben enthält zu
'Schriftart, Schrifttyp, Schriftgrösse etc.
Private Type TEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
End Type

'*--- Hier werden diverse API-Funktionen deklariert ---
Private Declare Function apiCreateFont Lib "gdi32" Alias "CreateFontA" _
(ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, _
ByVal W As Long, ByVal i As Long, ByVal u As Long, ByVal S As Long, _
ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _
ByVal PAF As Long, ByVal F As String) As Long

Private Declare Function apiSelectObject Lib "gdi32" Alias "SelectObject" (ByVal hDC As Long, _
ByVal hObject As Long) As Long

Private Declare Function apiDeleteObject Lib "gdi32" _
Alias "DeleteObject" (ByVal hObject As Long) As Long

Private Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long

Private Declare Function apiMulDiv Lib "kernel32" Alias "MulDiv" (ByVal nNumber As Long, _
ByVal nNumerator As Long, ByVal nDenominator As Long) As Long

Private Declare Function apiCreateIC Lib "gdi32" Alias "CreateICA" _
(ByVal lpDriverName As String, ByVal lpDeviceName As String, _
ByVal lpOutput As String, lpInitData As Any) As Long

Private Declare Function apiGetDC Lib "user32" _
Alias "GetDC" (ByVal hwnd As Long) As Long

Private Declare Function apiReleaseDC Lib "user32" _
Alias "ReleaseDC" (ByVal hwnd As Long, _
ByVal hDC As Long) As Long

Private Declare Function apiDeleteDC Lib "gdi32" _
Alias "DeleteDC" (ByVal hDC As Long) As Long

Private Declare Function apiGetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" _
(ByVal hDC As Long, lpMetrics As TEXTMETRIC) As Long
'*--- Ende der API-Funktionen ---

'Konstanten deklarieren
Const TWIPSPERINCH = 1440

'Logische Pixel/Inch in Y-Achse
Const LOGPIXELSY = 90

'öffentliche Variable für Report-Klassenmodul
Public sTM As TEXTMETRIC

Public Function fTextMetric(ctl As Control) As Long
'Wurde ein Textfeld übergeben?
If IsNull(ctl.FontSize) Then Exit Function

'Reportfenster
Dim hwnd As Long

'Reportgerät
Dim hDC As Long

'Bildschirmauflösung
Dim lngYdpi As Long

'neues Fontobjekt (muss beim Beenden der Funktion zerstört werden
Dim newfont As Long

'altes Fontobjekt
Dim oldfont As Long

'Returns von API-Aufrufen
Dim lngRet As Long

'Fonthöhe ausrechnen
Dim fheight As Long

'Control-Parent
hwnd = ctl.Parent.hwnd
If IsNull(hwnd) Then Exit Function

'Geräte-Kontext
hDC = apiGetDC(hwnd)

'Rückgabewert löschen
lngRet = 0

'temporäre Information für Screen-Info-Kontext
Dim lngIC As Long

'variierende Bildschirm- und Druckerauflösungen
lngIC = apiCreateIC("DISPLAY", vbNullString, vbNullString, vbNullString)
If lngIC 0 Then
lngYdpi = apiGetDeviceCaps(lngIC, LOGPIXELSY)
apiDeleteDC (lngIC)
Else
lngYdpi = 120 'Default average value
End If

'verlangte Fonthöhe berechnen
fheight = apiMulDiv(ctl.FontSize, lngYdpi, 72)

With ctl
newfont = apiCreateFont(-fheight, 0, _
900, 0, .FontBold, _
.FontItalic, .FontWeight, _
0, 0, 0, _
0, 0, 0, .FontName)
End With

'neues Font auswählen
oldfont = apiSelectObject(hDC, newfont)

lngRet = apiGetTextMetrics(hDC, sTM)

'konvertieren in Twips
sTM.tmAscent = sTM.tmAscent * (TWIPSPERINCH / lngYdpi)
sTM.tmDescent = sTM.tmDescent * (TWIPSPERINCH / lngYdpi)
sTM.tmExternalLeading = sTM.tmExternalLeading * (TWIPSPERINCH / lngYdpi)
sTM.tmHeight = sTM.tmHeight * (TWIPSPERINCH / lngYdpi)
sTM.tmInternalLeading = sTM.tmInternalLeading * (TWIPSPERINCH / lngYdpi)

'aufräumen
lngRet = apiSelectObject(hDC, oldfont)

'Font löschen
apiDeleteObject (newfont)

lngRet = apiReleaseDC(hwnd, hDC)
fTextMetric = True
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Grüsse
Thomas

Thomas Braun · 23. September 2003

Am kompilieren liegts m.E. definitiv nicht. In der mde hast du nur kompilierten Code und mit der läufts ja auch nicht schneller.
Ich habe mir den Code jetzt nicht bis ins Detail angesehen, aber eigentlich sollten die Einstellungen auch durch einen ordentlichen Berichtsentwurf gemacht werden können.
Vielleicht liegts ja doch an der Datenherkunft.
Du kannst ja mal testen, wie lange die zugrundeliegende Abfrage zum Anzeigen der Daten braucht.

Sascha Trowitzsch · 23. September 2003

Dass der Bericht langsam ist wundert mich bei diesem Code nicht.

Da würde auch ein Übernehmen in VB - was so nicht geht - gar nichts bringen. (Im Gegenteil, da der Bericht unter Access läuft, jedoch von VB aus gesteuert würde, würde noch mehr Rechenpower für die Automation draufgehen.)

Es liegt auch ein Missverständnis vor: Access kompiliert seinen VBA-Code nicht jedesmal, wenn es ihn aufruft. Ist er nach der letzen Änderung erst einmal kompiliert, so bleibt das auch so.

Es scheint zwar ein superdynamaischer Bericht zu sein, in dem das Layout jedem einzelnen Feld bzw. der Größe seines Inhalts angepasst wird - und der Entwickler hat sich wirklich Mühe gegeben - aber bei vielen Seiten im Bericht ist die Kehrseite eben, dass diese Berechnungen ziemlich lange dauern. Damit wirst du leben müssen.

Ciao, Sascha

Thomas_Engel · 23. September 2003

\@Thomas:
Leider lässt sich das, was der Code bewirkt nicht im Berichtsentwurf realisieren. Sieh mal hier:
Das hier zeigt einen Berichtsauschnitt mit 2 Datensätzen ohne Formatierung per VBA-Code:

Und dieses hier zeigt dasselbe aber mit Formatierung:

Es geht dabei darum, einzelne Berichtsfelder am unteren Rand eines anderen Feldes auszurichten, welches dynamisch seine Grösse an den beinhaltenden Text angleicht. Das kann Access aber von sich aus nicht.

@Sascha:
Nun ist es so, meine Anwendung lässt Access im Hintergrund starten und schliesst Access auch gleich nach dem Druck wieder. Access bleibt also für den Anwender unsichtbar. Glaubst Du, es würde was bringen, Access im Hintergrund laufen zu lassen damit Access sofort verfügbar ist?

Grüsse und danke für Eure Mithilfe
Thomas

Sascha Trowitzsch · 23. September 2003

Tja Gott, wenn der Bericht öfters aufgerufen wird, so ist es sicher sinnvoll, nicht jedesmal extra Access anzuschmeißen und die DB zu laden.
Ja, da würde ich beim ersten Start des Berichts das Access-Objekt laden und dann geöffnet lassen und erst beim Beenden deines Programm ebenfalls entladen.

Ciao, Sascha

Thomas_Engel · 23. September 2003

Danke Sascha,

teste ich mal. Da muss ich natürlich auch noch eine Boolean-Variable auf true setzen, wenn Access geöffnet wird bzw. auf false, wenn Access beendet wird. Nicht dass ich dann den ganzen Arbeitspeicher mit Dutzenden Access.exes gefüllt habe :-)

Grüsse
Thomas

Sascha Trowitzsch · 23. September 2003

Das brauchst du nicht, wenn du die Automation mit

GetObject(,"Deine.mdb")

bewerkstelligst.
Falls Access mit der DB noch nicht offen ist, so wird es geöffnet.
Falls es schon offen ist, so wird keine neue Instanz geöffnet, sondern auf die bereits geöffnete verwiesen.

Ciao, Sascha

Thomas_Engel · 24. September 2003

Danke Sascha,

so meinte ich das eigentlich auch:
Code:

Public Sub PrintAccRpt(sDbPath As String, sReportName As String, Optional sSQL As Variant)
'Error-Variable setzen
bolAccRptError = False
On Error GoTo ErrPrint
'Prüfen ob Access geöffnet ist
If bolReports = False Then
'Access initialisieren
Set appAcc = CreateObject("Access.Application")
'Reporting-DB öffnen
appAcc.OpenCurrentDatabase (sDbPath)
bolReports = True
Else
Set appAcc = GetObject(sDbPath)
End If
'Bericht wird mit angegebenen Parametern gedruckt
'ohne Vorschau
If intPreview = 1 Then
appAcc.DoCmd.OpenReport sReportName, acViewNormal, sSQL
appAcc.Visible = False
ElseIf intPreview = 2 Then
'mit Vorschau
appAcc.DoCmd.OpenReport sReportName, acViewPreview, sSQL
appAcc.Visible = True
appAcc.DoCmd.Maximize
While appAcc.Visible = True
DoEvents
Wend
End If
...
...
...
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Grüsse
Thomas

Sascha Trowitzsch · 24. September 2003

Aber ich meinte es nicht so.

Es reicht einfach:

Set appAcc = GetObject(sDbPath)

Es muss damit nicht überprüft werden, ob Access schon offen ist.
(s. Hilfe zu GetObject.)

Mit GetObject wird nicht jedesmal eine neue Instanz gestartet. Umgekehrt: Falls noch keine Instanz besteht, dann erzeugt es eine. So intelligent ist die Funktion! *wink.gif*

Deshalb kannst du dir das mit der Boolschen sparen.

Ciao, Sascha

Thomas_Engel · 24. September 2003

Staunemann und Söhne! Tatsächlich, das wusste ich gar nicht.
Tja, man lernt eben nie aus :-)

Danke für diesen Tipp

viele Grüsse
Thomas

Office: VBA-Code kompilieren

VBA-Code kompilieren

VBA-Code kompilieren

VBA-Code kompilieren

VBA-Code kompilieren

VBA-Code kompilieren - Similar Threads - VBA Code kompilieren

Per Hyperlink ausgeblendetes Blatt einblenden

VBA Code für Zeilen ausblenden einblenden mit JA/Nein

VBA Code ohne ergebnis

VBA Code Anpassen "Wert Einfügen statt Formel"

Excel VBA - Code Hilfe (Spalten, Werte kopieren etc.)

VBA Code " Zeilenhöhe bei Verb. Zellen Funktioniert fasst"

PDF mit Namen,Datum speichern im Zielordner