November 28, 2020, 13:59:30

Neuigkeiten:

Ist euer Problem gelöst, dann bitte den Knopf "Thema gelöst" drücken!


Formular hängt sich auf solange ein OLE Objekt aktiv ist

Begonnen von stefanz1984, August 18, 2020, 08:55:51

⏪ vorheriges - nächstes ⏩

stefanz1984

Ich habe ein Problem mit einem Formular das aus einer Excel sheet ein Bild heraus holt und es anzeigt. Sobald das Bild im Formular ist kann ich nur noch das Bild anklicken und sbald ich es lösche kann ich alle buttons wieder betätigen.

Option Compare Database
Option Explicit


Private Sub cmdAbbrechen_Click()
DoCmd.Close
'Forms("frmHaupt").Requery
'Forms("frmHaupt")![txtSchadenTotal] = Forms("frmHaupt")![txtTotalGerechnet]

End Sub

' Eventfunction Button "Details" Click
' modified lu 10.02.2014
' changing generell handling ....
Private Sub cmdDetails_Click()
  On Error Resume Next
 
  Dim UnfallXLS As Excel.Workbook
  Dim xlApp As Excel.Application, xlBook As Excel.Workbook, xlSheet As Excel.Worksheet
  ' Dim oExcelWorkbook As Excel.Workbook
  Dim strFilePend As String
  Dim strFileDone As String
  Dim strFileExcel As String
 
  Dim bFilePendingExist As Boolean
  Dim bFileDoneExist As Boolean
 
  Const cstPath_pend As String = "g:\vbsg\gmeinsam\Unfallwesen\pendent\"    'für pendente Fälle
  Const cstPath_abg As String = "g:\vbsg\gmeinsam\Unfallwesen\abgerechnet\"    'für abgerechnete Fälle
 
  strFilePend = Forms("frmHaupt")![txtVBSG_Nr]        ' get the filename from [form "frmHaupt"] for building Filennames
  strFileDone = cstPath_abg & strFilePend & "_F.xls"  ' build filename for done case
  strFilePend = cstPath_pend & strFilePend & "_F.xls" ' build filename for pending case
  ' old code start
  'Prüfen, ob Datei bereits existiert
  'Set UnfallXLS = GetObject(varDatei)
  'If Err.Number = 0 Then
  '  Err.Clear
  'Else
  '  Err.Clear
  '  Set UnfallXLS = GetObject(vardateiAbg)   'abgerechneter Fall
  'End If
  ' old code end
  bFilePendingExist = FileExist(strFilePend) ' check file exists
  bFileDoneExist = FileExist(strFileDone) ' check file exists
  If (bFilePendingExist Or bFileDoneExist) Then ' one of them must be exist in case of both exists pending has priority
    strFileExcel = IIf(bFilePendingExist, strFilePend, strFileDone)
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True            ' make it visible
    xlApp.WindowState = xlMaximized ' maximice application window
   
    Set UnfallXLS = xlApp.Workbooks.Open(strFileExcel, ReadOnly:=False) ' open excel file
    With UnfallXLS
     
      .Application.Visible = True
      .Application.Windows(1).Visible = True
      .Sheets(1).Unprotect
      .Sheets(1).Range("Access").Value = "Access" ' set calling from access
      .Sheets(1).Protect  ' protect the first sheet
      .Sheets(1).Protect DrawingObjects:=False, Contents:=True, Scenarios:=True ' selective protect for first sheet
 
      .Sheets(2).Select ' simulate trigger the event  ... of the first sheet (sheet(1))
      .Sheets(1).Select ' here is firing event
      .Sheets(1).Range("Bemerkungen").Select
   
    End With
   
    Set UnfallXLS = Nothing ' closing reference
    Set xlApp = Nothing     ' closing reference
   
  Else
   
    MsgBox "Es existieren keine Dateien, weder im erledigten noch im unerledigten Bereich !"
 
  End If

End Sub

Private Sub Form_Close()
Me![txtBetrag_TA].Locked = True
Me![txtSchaden_VBSG].Locked = True
Me![txtaktTA].Locked = True
Me![oleSchaden_Bild].Locked = True

End Sub