PDA

Vollständige Version anzeigen : Bunte Endlosformulare Teil2-OLE-Feld mit Datei füllen, ohne Access-Dialog


Marsu65
31.01.2013, 07:03
Hallo zusammen,
hier nun Teil2, in dem gezeigt wird, wie man den Inhalt einer Datei - nur mit VBA - in ein OLE-Feld einbettet(!).

Prinzip:
Es wird ein Formular (sfrm_File_To_OLE) benötigt,
dass ein gebundenes (!) OLE-Steuerelement (oleg) enthält.
(Formular-Eigenschaft 'enthält Modul' auf 'Ja' einstellen!)

Die Klasse 'cls_File_To_OLE' kümmert sich um den Rest

Um einem OLE-Tabellenfeld eine Datei zuzuweisen, wird der Klasse
- der vollständige Dateipfad
- der Tabellenname
- der Name des OLE-Feldes in der Tabelle
- der Name des Feldes, das den Datensatz eindeutig identifiziert
- und ein Kriterienwert zur Identifikation des Datensatzes (Zahl oder String)
als Eigenschaft übergeben.

Abschließend wird die Methode 'File_To_OLE' ausgeführt.
Die Klasse öffnet das Formular unsichtbar, stellt die Datenherkunft ein,
füllt das OLE-Feld mit der Datei und speichert den Datensatz.
Beim Zerstören der Klasse wird das Formular wieder geschlossen.

Bsp.Code:
Dim tempPath As String
Dim FTO As cls_File_To_OLE
tempPath = CurrentProject.Path & "\Beispieldatei.bmp"

Set FTO = New cls_File_To_OLE
With FTO
.File = tempPath
.Tablename = "TabelleMitOLEFeld"
.IDField = "Autowertfeld"
.Krit = Vergleichswert 'bzw. "Vergleichsstring"
.OLEField = "OLEFeldname"
.File_To_OLE
End With
Set FTO = Nothing
...

Klassencode 'cls_File_To_OLE':
Option Compare Database
Option Explicit

'//////////////////////////////////////////////////////////////////////////////////////////
'// Klasse zum Fuellen eines OLE Tabellenfeldes mit einer Datei
'// Benoetigt ein Formular sfrm_File_To_OLE mit einem gebundenem OLE-Steuerelement (OLEG)
'//
'// Autor: Axel Prott (DeBePRO)
'// (c) Das Modul und Teile davon dürfen frei verwendet werden.
'// Ein Hinweis auf den Autor/die Herkunft gehört zum guten Ton!
'//////////////////////////////////////////////////////////////////////////////////////////

Private m_Table As String 'Tabelle in der die Daten geändert werden sollen
Private m_IDField As String 'Name des Feldes, das den Datensatz identifiziert
Private m_OLEField As String 'Name des OLE-Feldes, das neue Daten bekommen soll
Private m_Krit As Variant 'Kriterium zu Datensatzauswahl

Private m_File As String 'Kompletter Pfad der Datei, die im OLE landen soll
'Private m_Class As String 'Klasse des OLEfeldes (Bei Bitmap, PDF ... nicht nötig)

Private m_Form As Form_sfrm_File_To_OLE
'***

'**********************************************************
'*** CLASS
'**********************************************************
Private Sub Class_Terminate()
Set m_Form = Nothing
End Sub


'**********************************************************
'*** PROPERTIES
'**********************************************************
Public Property Let Tablename(Tablename As String)
m_Table = Tablename
End Property

Public Property Let IDField(IDFieldname As String)
m_IDField = IDFieldname
End Property

Public Property Let OLEField(OLEFieldname As String)
m_OLEField = OLEFieldname
End Property

Public Property Let Krit(KritValue As Variant)
m_Krit = KritValue
End Property

Public Property Let File(Filename As String)
If Len(Dir(Filename)) > 0 Then
m_File = Filename
Else
Err.Raise vbObjectError, "Prty File/cls_File_To_Class", "File not found"
End If
End Property

'Public Property Let Class(OLEClass As String)
' m_Class = OLEClass
'End Property


'**********************************************************
'*** METHODEN
'**********************************************************
Public Sub File_To_OLE()
On Error GoTo Fehler
Dim ctlOLE As Access.Control

With MyForm
.RecordSource = FormDatasource
If .Recordset.RecordCount = 0 Then
MsgBox "Keinen Datensatz gefunden!"
Resume exit_here
End If
!OLEG.ControlSource = m_OLEField
Set ctlOLE = !OLEG
End With
ctlOLE.SourceDoc = m_File
ctlOLE.Action = 0 'OLE_CREATE_EMBED (Notwendig, damit Aenderung sichtbar wird)
MyForm.Dirty = False
exit_here:
Set ctlOLE = Nothing
Exit Sub
Fehler:
MsgBox "Error in File_To_OLE/Class cls_File_To_OLE " & vbCrLf & Err.Number & ": " & Err.Description
Resume exit_here
End Sub


'**********************************************************
'*** HILFSFUNKTIONEN
'**********************************************************
Private Function MyForm() As Form_sfrm_File_To_OLE
If m_Form Is Nothing Then
Set m_Form = New Form_sfrm_File_To_OLE
m_Form.Visible = False
End If
Set MyForm = m_Form
End Function


Private Function FormDatasource() As String
'/ Datensatzherkunft fuer das Formular sfrm_File_To_OLE
Dim sSQL As String
sSQL = "SELECT [" & m_OLEField & "] " & _
"FROM [" & m_Table & "] " & _
"WHERE [" & m_IDField & "] "
If IsNumeric(m_Krit) Then 'Kriterium als Zahl
sSQL = sSQL & "=" & m_Krit
ElseIf VarType(m_Krit) = vbString Then 'Kriterium als String
sSQL = sSQL & "='" & m_Krit & "'"
Else
sSQL = vbNullString '=> Fehler
End If
FormDatasource = sSQL
End Function


Hinweis: auf Fehlerbehandlung wurde wg. der Übersichtlichkeit weitgehend verzichtet.
Getestet unter WinXPPro/Office2003Pro mit BMP und PDF-Dateien

Kommentare erwünscht! ;)