title image


Smiley Re: Ist mir nicht bekannt...
Hallo Reinhard,



danke für Deine (wie immer) schnelle Antwort.



ich habe den Code von K. Blum bekommen. ( ich selbst habe keine Erfahrung in VB ) Der u.g. Code wird durch das Öffnen eines Forms aufgerufen.



In einer tbl sind die Bilder-Pfade fest angelegt.

( C:\bilder\1.jpg usw )



Es funzt nach Setup als Datenbank der 97er, 2k und xp-Version

sehr gut.



Sobald ich aber eine 97er Runtime erstelle, werden die Bilder

nicht mehr angezeigt. Das Form bleibt leer.



Evtl. muss ich in die SetupVersion der Runtime irgend etwas mit einbeziehen ? (MSgraph hab ich schon versucht, ging net)





- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -



Option Compare Database

Option Explicit

Dim sql As String, SuchenSQL As String, aktFilter As String, FilterSQL As String



Private Sub Beschreibung_LostFocus()

If Me.Dirty Then

DoCmd.RunCommand acCmdSaveRecord

End If

End Sub



Private Sub Copyright_Click()

DoCmd.OpenForm "frmInfo"

End Sub



Private Sub Detailbereich_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

'SchSchließen.SetFocus

End Sub



Private Sub Form_AfterUpdate()

On Error Resume Next

Me![Foto].Picture = Me![Ordner] & Me![Dateiname]

End Sub



Private Sub Form_Current()

On Error Resume Next

Dim BilderDatei As String, nr As Integer

nr = Me!FzgNr

BilderDatei = DLookup("Ordner", "Bilderpfad", "Fzgnr = " & nr) & DLookup("Dateiname", "Bilderpfad", "Fzgnr = " & nr)

Me!Foto.Picture = Nz(BilderDatei, "")



End Sub



Private Sub Form_Load()

If IsLoaded("frmBilderMenüTabelle") Then

Me.RecordSource = DatenHerkunft

End If

End Sub



Private Sub Form_Open(Cancel As Integer)

If IsLoaded("frmBilderMenüTabelle") Then

sql = "SELECT ["

sql = sql & Forms!frmBilderMenüTabelle!lstTables

sql = sql & "].Kategorie FROM ["

sql = sql & Forms!frmBilderMenüTabelle!lstTables

sql = sql & "] GROUP BY ["

sql = sql & Forms!frmBilderMenüTabelle!lstTables

sql = sql & "].Kategorie ORDER BY ["

sql = sql & Forms!frmBilderMenüTabelle!lstTables

'sql = sql & "].Kategorie;"

'SuchenSQL = "SELECT ["

'SuchenSQL = SuchenSQL & Forms!frmBilderMenüTabelle!lstTables

'SuchenSQL = SuchenSQL & "].Dateiname FROM ["

'SuchenSQL = SuchenSQL & Forms!frmBilderMenüTabelle!lstTables

'SuchenSQL = SuchenSQL & "] GROUP BY ["

'SuchenSQL = SuchenSQL & Forms!frmBilderMenüTabelle!lstTables

'SuchenSQL = SuchenSQL & "].Dateiname ORDER BY Dateiname;"

'NameSuchen.RowSource = SuchenSQL

'VorhKategorien.RowSource = sql

End If

End Sub



Private Sub NameSuchen_AfterUpdate()

Dateiname.SetFocus

DoCmd.FindRecord NameSuchen, acEntire, False, acDown, False, , True

SchSchließen.SetFocus

End Sub



Private Sub SchAlle_Click()

Me.RecordSource = DatenHerkunft

VorhKategorien = Null

NameSuchen = Null

NameSuchen.RowSource = SuchenSQL

SchSchließen.SetFocus

End Sub



Private Sub SchaltflächeNeu_Click()

DoCmd.OpenForm "frmFotosNeu", acViewNormal, acEdit

Forms!frmFotosNeu.RecordSource = Forms!frmFotosAnzeigen.RecordSource

DoCmd.GoToRecord , , acNewRec

End Sub



Private Sub SchDrucken_Click()

On Error GoTo Err_Drucken



Dim sDatei As String

sDatei = Me![Ordner] & Me![Dateiname]

If Not FileExists(sDatei) Then

If Left(sDatei, 3) = cdLW() Then

MsgBox "Es liegt nicht die richtige CD im Laufwerk " & cdLW, vbExclamation, "CD-Fehler"

Exit Sub

End If

MsgBox "Die ausgewählte Datei existiert nicht (wurde evtl. gelöscht, verschoben oder umbenannt)!", vbInformation, "Fehler"

Exit Sub

End If

DoCmd.OpenReport "rptBilderAnzeigen", acViewPreview, , "Dateiname = Forms!frmFotosAnzeigen!Dateiname"

Me.Visible = False

If IsLoaded("frmBilderMenüTabelle") Then

Forms!frmBilderMenüTabelle.Visible = False

End If



Exit_Drucken:

Exit Sub



Err_Drucken:

MsgBox err.Description, vbInformation, "Fehler"

Resume Exit_Drucken



End Sub



Private Sub SchErster_Click()

On Error Resume Next

DoCmd.GoToRecord , , acFirst

End Sub



Private Sub SchLetzter_Click()

On Error Resume Next

DoCmd.GoToRecord , , acLast

End Sub



Private Sub SchNächster_Click()

On Error Resume Next

DoCmd.GoToRecord , , acNext

End Sub



Private Sub SchSchließen_Click()

DoCmd.Close

End Sub



Private Sub SchVoriger_Click()

On Error Resume Next

DoCmd.GoToRecord , , acPrevious

End Sub



Private Sub VorhKategorien_AfterUpdate()

Me.RecordSource = DatenHerkunftFilter

FilterSQL = "SELECT ["

FilterSQL = FilterSQL & Forms!frmBilderMenüTabelle!lstTables

FilterSQL = FilterSQL & "].Dateiname FROM ["

FilterSQL = FilterSQL & Forms!frmBilderMenüTabelle!lstTables

FilterSQL = FilterSQL & "] WHERE (((["

FilterSQL = FilterSQL & Forms!frmBilderMenüTabelle!lstTables

FilterSQL = FilterSQL & "].Kategorie) = [Forms]![frmFotosAnzeigen]![VorhKategorien])) ORDER BY ["

FilterSQL = FilterSQL & Forms!frmBilderMenüTabelle!lstTables

FilterSQL = FilterSQL & "].Dateiname;"

NameSuchen.RowSource = FilterSQL

NameSuchen = Null

End Sub

Private Sub SchLöschen_Click()

On Error GoTo Err_SchLöschen_Click



If MsgBox("Wollen Sie das Foto '" & UCase(Dateiname) & "' wirklich aus der Datenbank entfernen?" & vbCrLf & vbCrLf & "Hinweis:" & vbCrLf & "Es wird lediglich der Verweis gelöscht, die Datei bleibt erhalten!", 292, "Datensätze löschen") = 6 Then

DoCmd.SetWarnings False

DoCmd.RunCommand acCmdDeleteRecord

DoCmd.Requery

End If



Exit_SchLöschen_Click:

DoCmd.SetWarnings True

SchSchließen.SetFocus

Exit Sub



Err_SchLöschen_Click:

MsgBox err.Description

Resume Exit_SchLöschen_Click



End Sub

Private Sub SchKopieren_Click()

On Error GoTo Err_SchKopieren_Click



Dim suchtext As String

DoCmd.OpenForm "frmKopieren"

Forms!frmKopieren!aktTabelle = Forms!frmBilderMenüTabelle.lstTables

Forms!frmKopieren.RecordSource = Forms!frmKopieren.aktTabelle

suchtext = Forms!frmFotosAnzeigen!Dateiname

DoCmd.SelectObject acForm, "frmKopieren"

Dateiname.SetFocus

DoCmd.FindRecord suchtext, acEntire, False, acSearchAll, True, acCurrent

Forms!frmKopieren!Zielpfad.SetFocus



Exit_SchKopieren_Click:

Exit Sub



Err_SchKopieren_Click:

MsgBox err.Description

Resume Exit_SchKopieren_Click



End Sub

Sub Kombinationsfeld25_AfterUpdate()

' Den mit dem Steuerelement übereinstimmenden Datensatz suchen.

Me.RecordsetClone.FindFirst "[IDNum] = " & Me![Kombinationsfeld25]

Me.Bookmark = Me.RecordsetClone.Bookmark

End Sub



Sub Kombinationsfeld27_AfterUpdate()

' Den mit dem Steuerelement übereinstimmenden Datensatz suchen.

Me.RecordsetClone.FindFirst "[IDNum] = " & Me![Kombinationsfeld27]

Me.Bookmark = Me.RecordsetClone.Bookmark

End Sub



Private Sub Befehl29_Click()

On Error GoTo Err_Befehl29_Click





DoCmd.GoToRecord , , acNext



Exit_Befehl29_Click:

Exit Sub



Err_Befehl29_Click:

MsgBox err.Description

Resume Exit_Befehl29_Click



End Sub

Private Sub Befehl30_Click()

On Error GoTo Err_Befehl30_Click





DoCmd.GoToRecord , , acPrevious



Exit_Befehl30_Click:

Exit Sub



Err_Befehl30_Click:

MsgBox err.Description

Resume Exit_Befehl30_Click



End Sub





------------------

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: