Hilfe !!!!!! Dringend
Nach Umstellung auf Win 7 64 Bit bekomme ich beim Öffnen eines Access Formulars
eine Fehlermeldung Fehler Scan_Form form_open Fehler 438. Kann mir jemand helfen?
Ich benutze Office 2007.
Formular hat folgenden VBACode:
' hier gehts los...
' #################
Private Sub Form_Open(Cancel As Integer)
' falls kein Dateiname übergeben wurde...
myFileName = "C:\__SCAN__.tif"
Me.lbDokumentname.Caption = " " & myFileName
On Error GoTo Err_Form_Open
myError = 0
bScanDialog = False
If UCase(GetSystemValue("ScanDirect")) = "TRUE" Then
Me.chkOhneScanDialog = True
Else
Me.chkOhneScanDialog = False
End If
' Scannertreiber vorhanden?
If Me.CtlScan.ScannerAvailable = True Then
Me.lbScanner.Caption = fGetScannerName()
Else
Me.lbScanner.Caption = "kein Scanner vorhanden"
Me.lbScanner.BackColor = vbRed
Me.btScanNew.Enabled = False
Me.btScannerEinst.Enabled = False
Me.btScannerSelect.Enabled = False
End If
' Operation und Filename übernehmen
If Len(Me.OpenArgs) > 0 Then
myOperation = CInt(Left(Me.OpenArgs, 1))
myFileName = Mid(Me.OpenArgs, 2)
Me.lbDokumentname.Caption = " " & myFileName
lbZoom.Caption = ""
' Operation auswählen
Select Case myOperation
' vorhandenes Dokument anzeigen
Case DOC_EDIT
CtlAdmin.Image = myFileName
With CtlPreview
.Image = myFileName
.DisplayThumbs
.ThumbSelected(1) = True
End With
With CtlEdit
.Image = myFileName
.Page = 1
.FitTo 1 ' wiFIT_TO_WIDTH
.Display
End With
End Select
End If
Exit_Form_Open:
Exit Sub
Err_Form_Open:
MsgBox "Fehler in frm_Scan: Form_Open" & vbCrLf & err.Number & ": " & err.Description, vbExclamation + vbOKOnly, "Fehler..."
Resume Exit_Form_Open
End Sub
' Dokument ausdrucken
Private Sub btPrint_Click()
On Error GoTo Err_btPrint_Click
' Druckdialog des Admin-Controls anzeigen
CtlAdmin.CancelError = True
CtlAdmin.PrintNumCopies = 1
CtlAdmin.Image = CtlEdit.Image
CtlAdmin.ShowPrintDialog Me.hWnd
'drucken der Datei, die Werte aus dem Druckerdialog werden als Parameter übergeben
CtlEdit.PrintImage CtlAdmin.PrintStartPage, CtlAdmin.PrintEndPage, _
CtlAdmin.PrintOutputFormat, CtlAdmin.PrintAnnotations
Exit_btPrint_Click:
Exit Sub
Err_btPrint_Click:
Select Case err.Number
Case 32755 ' Abbruch...
Case 53 ' kein Bild zum Drucken vorhanden
Case Else
MsgBox "Fehler in frm_Scan: btPrint_Click" & vbCrLf & err.Number & ": " & err.Description, vbExclamation + vbOKOnly, "Fehler..."
End Select
Resume Exit_btPrint_Click
End Sub
' speichern des Dokuments
Private Sub btSave_Click()
On Error Resume Next
If CtlEdit.Image <> "" Then
CtlEdit.Save
End If
End Sub
' hier passiert das Scannen
Private Sub btScanNew_Click()
Dim iTmb As Integer
Dim lScanError As Long
On Error GoTo Err_btScanNew_Click
' Scanner öffnen
lScanError = CtlScan.OpenScanner
' hat's geklappt ???
If lScanError <> 0 Then
CtlScan.CloseScanner
Exit Sub
End If
CtlScan.Image = myFileName
CtlScan.Scroll = True
' keinen Scanner-Dialog anzeigen
If chkOhneScanDialog Then
With CtlScan
.ShowSetupBeforeScan = False
.FileType = 1 ' TIF
.PageType = 7 ' 24-Bit-Farbtiefe
.CompressionType = 6 ' JPEG-Kompression
End With
Else
CtlScan.ShowSetupBeforeScan = True
End If
' Scan einfügen?
If chkInsertScan Then
CtlScan.MultiPage = True
If CtlPreview.ThumbCount > 0 Then
' CtlScan.PageOption = 3 'neuer Scann wird vor die markierte Seite gelegt
' Bild anfügen
CtlScan.PageOption = 2
CtlScan.Page = CtlPreview.ThumbCount + 1
Else
' erstes Bild
CtlScan.PageOption = 1
CtlScan.Page = 1
End If
' sonst eventuell altes Bild speichern und neu
Else
If CtlEdit.ImageModified Then SaveImage
CtlEdit.ClearDisplay
CtlEdit.Image = ""
CtlPreview.Image = ""
For iTmb = 1 To CtlPreview.ThumbCount Step 1
CtlPreview.ClearThumbs iTmb
Next iTmb
CtlPreview.Refresh
CtlScan.MultiPage = False
CtlScan.PageOption = 1
CtlScan.Page = 1
End If
' hier scannen
CtlScan.ResetScanner
CtlScan.ScanTo = 2 ' nur Datei
lScanError = CtlScan.StartScan
' Fehler aufgetreten?
If lScanError <> 0 Then
CtlScan.CloseScanner
Exit Sub
End If
If CtlScan.Image <> "" Then
CtlPreview.Image = CtlScan.Image
CtlPreview.Requery
CtlPreview.ThumbSelected(CtlPreview.ThumbCount) = True
CtlEdit.Image = CtlScan.Image
CtlEdit.FitTo 1 ' wiFIT_TO_WIDTH
lbZoom.Caption = CInt(CtlEdit.Zoom) & " %"
CtlEdit.Page = CtlPreview.ThumbCount
CtlEdit.Display
End If
CtlScan.CloseScanner
Exit_btScanNew_Click:
Exit Sub
Err_btScanNew_Click:
Select Case err.Number
Case 1101 ' Scanner nicht angeschlossen
Case Else
MsgBox "Fehler in frm_Scan: btScanNew_Click" & vbCrLf & err.Number & ": " & err.Description, vbExclamation + vbOKOnly, "Fehler..."
End Select
Resume Exit_btScanNew_Click
End Sub
' Programmende über Button
Private Sub Button_schliessen_Click()
On Error GoTo Err_Button_schliessen_Click
DoCmd.Close
Exit_Button_schliessen_Click:
Exit Sub
Err_Button_schliessen_Click:
MsgBox "Fehler in frm_Scan: Button_schliessen_Click" & vbCrLf & err.Number & ": " & err.Description, vbExclamation + vbOKOnly, "Fehler..."
Resume Exit_Button_schliessen_Click
End Sub
' Vorschaubild auswählen
Private Sub CtlPreview_Click(ByVal ThumbNumber As Long)
Dim iCnt As Integer
On Error GoTo Err_CtlPreview_Click
' wenn Vorschaubilder vorhanden
If ThumbNumber <> 0 Then
' gibt es Änderungen am aktuellen Dokument?
If CtlEdit.ImageModified Then SaveImage
For iCnt = 1 To CtlPreview.ThumbCount Step 1
CtlPreview.ThumbSelected(iCnt) = False
Next iCnt
CtlPreview.ThumbSelected(ThumbNumber) = True
CtlEdit.Page = ThumbNumber
CtlEdit.Display
lbZoom.Caption = CInt(CtlEdit.Zoom) & " %"
' gibt es noch weitere Dokumente?
CheckNextPrevious
End If
Exit_CtlPreview_Click:
Exit Sub
Err_CtlPreview_Click:
MsgBox "Fehler in frm_Scan: CtlPreview_Click" & vbCrLf & err.Number & ": " & err.Description, vbExclamation + vbOKOnly, "Fehler..."
Resume Exit_CtlPreview_Click
End Sub
' Zoom-Faktor einstellen
Sub zoomen(faktor)
On Error Resume Next
If CtlEdit.Image <> "" Then
If faktor > 6554 Then faktor = 6554 ' Grenze lt. Doku
If faktor < 10 Then faktor = 10
CtlEdit.Zoom = faktor
lbZoom.Caption = CInt(CtlEdit.Zoom) & " %"
CtlEdit.Refresh
End If
End Sub
' Test ob weitere Dokumente vorhanden sind
Private Sub CheckNextPrevious()
' nur wenn überhaupt ein Dokument vorhanden
If CtlEdit.Image <> "" Then
' wenn es nur ein Dokument gibt; Buttons deaktivieren
If CtlEdit.PageCount = 1 Then
btPrev.Enabled = False
btNext.Enabled = False
' wenn es das letzte Dokument ist
ElseIf CtlEdit.Page = CtlEdit.PageCount Then
btPrev.Enabled = True
btPrev.SetFocus
btNext.Enabled = False
' wenn es das erste Dokument ist
ElseIf CtlEdit.Page = 1 Then
btNext.Enabled = True
btNext.SetFocus
btPrev.Enabled = False
' ... sonst Buttons aktivieren
Else
btPrev.Enabled = True
btNext.Enabled = True
End If
' sonst Buttons deaktivieren
Else
btPrev.Enabled = False
btNext.Enabled = False
End If
End Sub
' Bild speichern
Public Sub SaveImage()
If MsgBox("Das aktuelle Bild wurde geändert. Wollen Sie die Änderungen speichern?", _
vbQuestion + vbYesNo, "Änderung") = vbYes Then
If CtlEdit.ImageModified = True Then CtlEdit.BurnInAnnotations 2, 2
CtlEdit.Save
CtlPreview.Image = CtlEdit.Image
CtlPreview.Refresh
End If
End Sub
' leider will die Toolbox immer in den Hintergrund ?!?
Sub ToolBoxInFront()
Dim myTask As Long
Dim Result As Long
Dim TBhwnd As Long
Dim hWnd As Long
' eigene Task-Id ermitteln
Result = GetWindowThreadProcessId(Me.hWnd, myTask)
'Einstieg
hWnd = GetWindow(Me.hWnd, GW_HWNDFIRST)
'Alle vorhandenen Fenster abklappern
Do
If GetWindowInfo(hWnd, myTask) Then
' Toolbox immer im Vordergrund
SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
Exit Sub
End If
hWnd = GetWindow(hWnd, GW_HWNDNEXT)
Loop Until hWnd = 0
End Sub
' wird gebraucht für Sub ToolBoxInFront()
Private Function GetWindowInfo(ByVal hWnd As Long, ByVal myTask As Long) As Boolean
Dim Parent As Long
Dim Task As Long
Dim Result As Long
Dim Style As Long
Dim Title As String
Dim bFound As Boolean
bFound = False
'Darstellung des Fensters
Style = GetWindowLong(hWnd, GWL_STYLE)
Style = Style And (WS_VISIBLE Or WS_BORDER)
'Titel des Fenster auslesen
Result = GetWindowTextLength(hWnd) + 1
Title = Space$(Result)
Result = GetWindowText(hWnd, Title, Result)
Title = Left$(Title, Len(Title) - 1)
' Toolbox ist sichtbar und ohne Titel...
If Title = "" And Style = (WS_VISIBLE Or WS_BORDER) Then
' Elternfenster ermitteln
Parent = hWnd
Do
Parent = GetParent(Parent)
Loop Until Parent = 0
' Task Id ermitteln
Result = GetWindowThreadProcessId(hWnd, Task)
' Task muß übereinstimmen
If myTask = Task Then bFound = True
End If
GetWindowInfo = bFound
End Function
Function fGetScannerName()
Dim HKey As Long
Dim Buffer As String * 255
Dim Size As Long
Dim Typ As Long
Buffer = ""
Size = 255
fGetScannerName = ""
' Scanner erstmal unter HKLM suchen
If RegOpenKeyA(HKEY_LOCAL_MACHINE, "SOFTWARE\WOI\O/i", HKey) = 0 Then
RegQueryValueExA HKey, "Scanner", 0, Typ, Buffer, Size
fGetScannerName = Buffer
Else
' sonst auch unter HKCU
If RegOpenKeyA(HKEY_CURRENT_USER, "SOFTWARE\WOI\O/i", HKey) = 0 Then
RegQueryValueExA HKey, "Scanner", 0, Typ, Buffer, Size
fGetScannerName = Buffer
End If
End If
RegCloseKey HKey
End Function