Focus MsgBox bij "geen gegevens gebeurtenis"

[scw]

Goedendag,

Bij mijn rapport maak ik gebruik van de volgende code bij de "Geen gegevens Gebeurtenis"

Private Sub Report_NoData(Cancel As Integer)
On Error GoTo ErrorHandler

    MsgBox "Er zijn momenteel geen records.", vbInformation, "Titel DB"
    Cancel = True
    
ExitHandler:
    Exit Sub

ErrorHandler:
    MsgBox Err.Description
    Resume ExitHandler

End Sub

Dat werkt goed, alleen wanneer ik de MsgBox nu verschijnt, verdwijnen de twee forms die altijd openstaan als ik op het rapport klik. Dus het is zeg maar een totale focus alleen op de MsgBox totdat je hem weer wegklikt en dan verschijnen de twee forms weer. Is het mogelijk om die twee forms wel gewoon in beeld te laten zijn en dat de MsgBox er gewoon nog bovenop verschijnt? En zo ja, wat moet ik dan aanpassen in de code?

Alvast bedankt weer,

scw :thumb:

 

[OctaFish]

Dat hangt er vanaf hoe je de formulieren opent. Als je ze op Modaal hebt staan, blijven ze dacht ik wel op het scherm staan.

 

[scw]

Inderdaad is dat ook wat ik dacht, maar helaas werkt het niet... Het zal ongetwijfeld te maken hebben met het feit dat het rapport eerst geopend wordt en dan vervolgens gaat checken of er records zijn i.p.v. dat er eerst records gecheckt worden en vervolgens het rapport geopend wordt??

 

[OctaFish]

Dat speelt ook mee. Als je eerst de records wilt controleren hoef je het rapport ook niet te openen; de recordset die je voor het rapport gebruikt kun je uiteraard ook gebruiken om te controleren of er records in zitten. Zo nee, dan hoef je het rapport niet te openen.

 

[scw]

Hmmm, ik gebruik geen recordset om de rapporten te openen. Maar is er wel een stukje code met recordset erin die ik eerst kan uitvoeren??

 

[OctaFish]

Je bedoelt dat er geen records zijn voor je rapport? Wat staat er dan op?? Je hebt toch een bron voor je rapport? En het rapport wordt toch geopend met een knop op een formulier? Wat je dus moet doen, is de bron van het rapport openen vanuit het formulier, en eerst controleren of er records zijn voor het rapport. Ja: rapport tonen, nee: niks doen.

 

[scw]

Ja excuus, ik heb natuurlijk wel een recordsource voor m'n rapporten. Ik begrijp wat je bedoeld, is er echter ook een stukje hapklare code beschikbaar voor dit proces voor een willekeurig tabel?

 

[OctaFish]

Hapklaar genoeg?

Sub RapportCheck(sRapport As String)
Dim sTabel As String
    DoCmd.OpenReport sRapport, acViewDesign, , , acHidden
    sTabel = Reports(sRapport).RecordSource
    DoCmd.Close acReport, sRapport, acSaveNo
    
    With CurrentDb.OpenRecordset(sTabel)
        If .RecordCount > 0 Then
            DoCmd.OpenReport sRapport, acViewPreview
        Else
            MsgBox "Dit rapport heeft helemaal niks...", vbOKOnly
        End If
        .Close
    End With
End Sub

Deze code maakt gebruik van een variabele: de rapportnaam (sRapport). De truc is als volgt: je opent het rapport in de Designmodus, vervolgens lees je de Recordbron in, en sluit je het rapport. Daarna controleer je met een recordset of er wat in zit.

 

[scw]

Hoi,

Het werkt aardig! Ik probeer het nu alleen nog even op een specifiek rapport toe te passen, met de volgende code:

Private Sub lstReports_DblClick(Cancel As Integer)
On Error GoTo ErrorHandler

Dim ReportName As String
Dim sTabel As String
ReportName = Me!lstReports

If Left$(ReportName, 3) = "frm" Then
    DoCmd.OpenForm ReportName, acNormal
ElseIf ReportName = rptA Then
    DoCmd.OpenReport rptA, acViewDesign, , , acHidden
    sTabel = Reports(rptA).RecordSource
    DoCmd.Close acReport, rptA, acSaveNo

    With CurrentDb.OpenRecordset(sTabel)
        If .RecordCount > 0 Then
            DoCmd.OpenReport rptA, acViewPreview
        Else
            MsgBox "Het werkt!", vbInformation, "Voorbeeld"
       End If
       .Close
       End With
Else
DoCmd.OpenReport ReportName, acViewPreview
End If

ExitHandler:
    Exit Sub

ErrorHandler:

    If Err = 2501 Then
    Resume ExitHandler
    
    Else
        MsgBox Err.Description
        Resume ExitHandler
        
        End If

End Sub

Access geeft géén foutmeldingen, maar geeft ook nog niet de melding bij dit specifieke rapport... wat scheelt er aan? Ik zie het niet...

 

[Harry46]

Nadeel van het gebruik van 'designview' is, dat het niet werkt in een mde-bestand.
Beter zou het zijn om gebruik te maken van van de fout die wordt gegenereerd bij 'cancellen' (neem aan de dat rapport wordt geopend vanuit een formulier)

 

[OctaFish]

Ik vermoed dat je ofwel een variabele niet hebt gedeclareerd, ofwel de naam van het rapport verkeerd gebruikt. Je kunt beide 'foutjes' met één regel herstellen:

const rptA="rptA"

Anders kun je een regel als

     DoCmd.OpenReport rptA, acViewDesign, , , acHidden

veranderen in

     DoCmd.OpenReport "rptA", acViewDesign, , , acHidden

En uiteraard de rest van de code ook.

 

[scw]

Hoi Harry46,

Bedankt voor je inbreng. Daar heb je zeker een punt! Wie weet wat de toekomst brengt en mogelijk wordt het inderdaad een MDE bestand. Kun je wat specifieker zijn over het 'cancellen'. Het rapport wordt inderdaad geopend vanuit een formulier.

 

[Harry46]

Het cancellen van een rapport (bij On No Data gebeurtenis Cancel=true) genereert een fout (2501), in het formulier van waaruit je het rapport opent. Door deze fout af te vangen, kun je daar de melding geven van 'geen records aanwezig'

Private Sub cmdAfdrukken_Click()

    On Error GoTo cmdAfdrukken_Click_Error

    DoCmd.OpenReport "rptMijnRapport", acViewPreview, , , acHidden    'eventueel where argument opnemen
    If Err = 0 Then
        Reports!rptMijnRapport.Visible = True
    End If

    On Error GoTo 0    'reset foutprocedure
    Exit Sub

cmdAfdrukken_Click_Error:
    If Err.Number = 2501 Then    'openen rapport is afgebroken
        MsgBox "Geen records in selectie"
    Else
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAfdrukken_Click"
    End If
End Sub

Het is bij het opzetten van een database altijd verstandig om rekening te houden met eventuele toekomstige veranderingen en uitbreidingen. Wanneer meerdere gebruikers met het programma moeten werken zul je moeten uitgaan van een 'frontend' en een 'backend'. Waarbij frontend locaal wordt geïnstalleerd en de backend op de server. In dit soort opstellingen wordt vaak voor de frontend gebruik gemaakt van een mde-bestand.

 

[scw]

Ah goede oplossing!!

Wat doe ik nog verkeerd in deze code (ik probeer de ene code te combineren met de andere...). Dus wat ik bereiken wil is dat die bij rptA die specifieke actie uitvoert

Private Sub cmdOpenReport_Click()
On Error GoTo ErrorHandler

Dim ReportName As String
ReportName = Me!lstReports

If Left$(ReportName, 3) = "frm" Then
DoCmd.OpenForm ReportName, acNormal
Else
DoCmd.OpenReport ReportName, acViewPreview
End If

If ReportName = rptA Then
 
    DoCmd.OpenReport "rptA", acViewPreview, , , acHidden
    If Err = 0 Then
        Reports!rptA.Visible = True
    End If

    On Error GoTo 0
    Exit Sub

cmdOpenReport_Click_Error:
    If Err.Number = 2501 Then
        MsgBox "Er zijn op dit moment geen records voor dit rapport.", vbInformation, "Voorbeeld"
    Else
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAfdrukken_Click"
    End If
    
ExitHandler:
    Exit Sub

ErrorHandler:

    If Err = 2501 Then
    Resume ExitHandler
    
    Else
        MsgBox Err.Description
        Resume ExitHandler
        
        End If

End Sub

 

[Harry46]

Ik kan er eerlijk gezegd van die code niet zoveel begrijpen.
Je opent een 'rapport' maar dat kan ook een formulier zijn?
Misschien dit:

Private Sub cmdAfdrukken_Click()

    Dim ReportName  As String

    On Error GoTo cmdAfdrukken_Click_Error

    ReportName = Me!lstReports

    If Left$(ReportName, 3) = "frm" Then
        DoCmd.OpenForm ReportName, acNormal
    Else
        DoCmd.OpenReport ReportName, acViewPreview, , , acHidden    'eventueel where argument opnemen
        If Err = 0 Then
            Reports(ReportName).Visible = True
        End If
    End If
    On Error GoTo 0    'reset foutprocedure
    Exit Sub

cmdAfdrukken_Click_Error:
    If Err.Number = 2501 Then    'openen rapport is afgebroken
        MsgBox "Geen records in selectie"
    Else
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAfdrukken_Click"
    End If
End Sub

Wellicht is het toch raadzaam om de bijelkaar gesprokkelde code, eerst goed te doorgronden, voordat je er zelf mee verder gaat. Anders lijkt mij het project gedoemd om te mislukken!

 

[scw]

Ja ik begrijp de codes afzonderlijk wel wat ze doen, alleen ben ik niet in staat ze te combineren in ��n stuk code.

Hij loopt goed:

If Left$(ReportName, 3) = "frm" Then
DoCmd.OpenForm ReportName, acNormal
Else
DoCmd.OpenReport ReportName, acViewPreview

Maar dan nog een If ReportName = rptA dan... zou ik Access specifiek die actie willen uitvoeren van:

    Else
        DoCmd.OpenReport ReportA, acViewPreview, , , acHidden    'eventueel where argument opnemen
        If Err = 0 Then
            Reports(ReportA).Visible = True
        End If
    End If
    On Error GoTo 0    'reset foutprocedure
    Exit Sub

cmdAfdrukken_Click_Error:
    If Err.Number = 2501 Then    'openen rapport is afgebroken
        MsgBox "Geen records in selectie"
    Else
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAfdrukken_Click"
    End If
End Sub

Is dit op de ��n of andere manier mogelijk??? Het is namelijk zo dat alleen dit specifieke rptA g��n records kan hebben, de andere kunnen geopend worden omdat ze allemaal altijd records hebben of het is een voorloopfrmpje welke voor het rapport wordt geopend namelijk...

 

[OctaFish]

Weet je wel zeker dat je code correct is? Je gooit, heb ik het idee, variabelenamen en Rapportnamen enigszins door elkaar: If ReportName = rptA is een verwijzing naar een Variabele, niet naar een Rapportnaam. Dan zou de code er zo uit moeten zien: If ReportName = "rptA"

 

[scw]

Hoi Octa & Harry, ik pas de volgende code nu toe. Doet het goed, echter geeft Access nog steeds niet bij rptA de gewenste MsgBox. Wat zal er nog veranderd moeten worden/kan ik nog wijzigen?!

Private Sub cmdOpenReport_Click()
On Error GoTo ErrorHandler

Dim ReportName As String
ReportName = Me!lstReports

If Left$(ReportName, 3) = "frm" Then
DoCmd.OpenForm ReportName, acNormal
Else
DoCmd.OpenReport ReportName, acViewPreview
End If

If ReportName = "rptA" Then
 
    DoCmd.OpenReport ReportName, acViewPreview, , , acHidden
    If Err = 0 Then
        Reports!ReportName.Visible = True
    ElseIf Err.Number = 2501 Then
        MsgBox "Er zijn op dit moment geen records voor rptA.", vbInformation, "Voorbeeld"
    Else
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAfdrukken_Click"
    End If
    
ExitHandler:
    Exit Sub

ErrorHandler:

    If Err = 2501 Then
    Resume ExitHandler
    
    Else
        MsgBox Err.Description
        Resume ExitHandler
        
        End If

End Sub

 

[OctaFish]

Ik snap niet hoe je kunt denken dat de code werkt, want er zit nog steeds een stevige fout in: er ontbreekt een End IF.

Private Sub cmdOpenReport_Click()
On Error GoTo ErrorHandler
Dim ReportName As String
ReportName = Me!lstReports
If Left$(ReportName, 3) = "frm" Then
    DoCmd.OpenForm ReportName, acNormal
Else
    DoCmd.OpenReport ReportName, acViewPreview
End If
If ReportName = "rptA" Then
    DoCmd.OpenReport ReportName, acViewPreview, , , acHidden
    If Err = 0 Then
        Reports!ReportName.Visible = True
    ElseIf Err.Number = 2501 Then
        MsgBox "Er zijn op dit moment geen records voor rptA.", vbInformation, "Voorbeeld"
    Else
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAfdrukken_Click"
    End If
[B][COLOR=blue]End If[/COLOR][/B]
ExitHandler:
Exit Sub
ErrorHandler:
If Err = 2501 Then
    Resume ExitHandler
Else
    MsgBox Err.Description
    Resume ExitHandler
End If
End Sub

Als je op <Foutopsporing>, <db compileren> klikt kom je 'm vanzelf tegen...

 

[scw]

nog steeds niet..

OK dat heb ik verbeterd... helaas heb ik nog steeds hetzelfde resultaat: rptA wordt wel geopend en er verschijnt geen MsgBox . Bij de rode tekst heb ik alles al geprobeerd met trema's (haakjes), maar dat verandere niets aan de zaak.

Pas de volgende code toe:

Private Sub cmdOpenReport_Click()
On Error GoTo ErrorHandler
Dim ReportName As String
ReportName = Me!lstReports
If Left$(ReportName, 3) = "frm" Then
    DoCmd.OpenForm ReportName, acNormal
Else
    DoCmd.OpenReport ReportName, acViewPreview
End If
If ReportName = [COLOR="red"]"rptA"[/COLOR] Then
    DoCmd.OpenReport [COLOR="red"]"rptA"[/COLOR], acViewPreview, , , acHidden
    If Err = 0 Then
        Reports![COLOR="red"]rptA[/COLOR].Visible = True
    ElseIf Err.Number = 2501 Then
        MsgBox "Er zijn op dit moment geen records voor rptA.", vbInformation, "Voorbeeld"
    Else
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAfdrukken_Click"
    End If
End If
ExitHandler:
Exit Sub
ErrorHandler:
If Err = 2501 Then
    Resume ExitHandler
Else
    MsgBox Err.Description
    Resume ExitHandler
End If
End Sub