vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
 Schützen Sie Ihre Software vor Software-Piraterie - mit sevLock 1.0 DLL!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2025
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

VB & Datenbanken
Re: Access DB Abfrage - Wie ? 
Autor: Prian0815
Datum: 30.03.04 12:42
Hi Boris,
Hier ein Code der auch wirklich funzt:
Das ganze funktioniert natürlich nur mit sortierten Tabellen. In deinem Fall muß die Tabelle nach Mitarbeiternamen sortiert sein.
Im GRUVOR_ initialisiere ich die Zäghlvariable, und merke mir den Mitarbeiternamen.
wenn in der Tabelle jetzt dann ein anderer Name kommt. macht das Programm vorher einen Gruppenabschluß für Miotarbeiter A
und dann wieder den Gruippenvorlauf für Mitarbeiter B.
du kannst das dann noch erweritern auf einern zweistufigen Gruppenwechsel, der dann z.B. noch das Datum berücksichtigt.
Private Sub CmdGru1_Click(Index As Integer)
On Error GoTo Fehler
' Aktuellen Pfad ermitteln
path = App.path
' Excel Öffnen und Sheet1 für Ausgabe vorbereiten
ZZ = 1
xlfilename = path + "/" + "Gru1Test.xls"
Set XLApp = GetObject(, Excel.Application)
Err.Clear ' Err-Objekt im Fehlerfall löschen.
Dateivorhanden = True
XLApp.Workbooks.Open xlfilename
Err.Clear ' Err-Objekt im Fehlerfall löschen
Set XLBook = XLApp.ActiveWorkbook
Set XLSheet = XLBook.Worksheets(1)
' aktuellen Pfad für Datenbankzugriff aufbereiten
filename = path & "/Access_Test.mdb"
Set db = OpenDatabase(filename) ' Datenbank öffnen
SQLstate = "SELECT *" _
& " From GruWeTest ORDER BY GruWeTest.Name;"
Set rs = db.OpenRecordset(SQLstate)
rs.MoveFirst
Do While rs.EOF = False
R1 = "A" & CInt(ZZ)
If hMerkfeld1 <> rs!Name Then
Gruvor
Else
Do While hMerkfeld1 = rs!Name
ZZ = ZZ + 1
R1 = "A" & CInt(ZZ)
XLSheet.Range(R1).Value = rs!Name
Anz1 = Anz1 + 1
rs.MoveNext
If rs.EOF = True Then Exit Do
Loop
Gruab
End If

Loop
Nachlauf
XLApp.DisplayAlerts = False
' EXCElsichtbar machen
'XLApp.Visible = True
' oder Datei speichern und Excel beenden
XLApp.ActiveWorkbook.SaveAs xlfilename
XLApp.Quit
Set XLBook = Nothing
Set XLApp = Nothing
db.Close
Set rs = Nothing
Set db = Nothing
Fehler:
Select Case Err.Number
Case 429 ' Excel lief nicht - Excel starten
Set XLApp = CreateObject("Excel.Application")
If XLApp Is Nothing Then
' Fehler: Excel nicht vorhanden!
MsgBox msgNoExcel, vbExclamation
Exit Sub
Else
Set XLApp = CreateObject("Excel.application")
Resume Next
End If
Case 1004
'Datei nicht vorhanden Neue Datei erstellen
Set XLBook = XLApp.Workbooks.Add
Dateivorhanden = False
Resume Next

Case Else
MsgBox Err.Description
Screen.MousePointer = 1
End Select
End Sub

Private Sub Gruab()
ZZ = ZZ + 2
R1 = "A" & Int(ZZ)
XLSheet.Range(R1).Value = " Der Name " & hMerkfeld1 & " kommt " & Anz1 & " mal vor"
ZZ = ZZ + 1
gesAnz = gesAnz + Anz1
End Sub

Private Sub Gruvor()
hMerkfeld1 = ""
Anz1 = 0
hMerkfeld1 = rs!Name
End Sub

Private Sub Nachlauf()
ZZ = ZZ + 2
R1 = "A" & Int(ZZ)
XLSheet.Range(R1).Value = "insgesamt sind" & gesAnz & "Einträge vorhanden"
XLSheet.Cells.Select
XLSheet.Cells.WrapText = False ' Zeilenumbruch ausschalten
R1 = "A1:B" & Int(ZZ)
XLSheet.Range(R1).Select
XLSheet.Range(R1).Columns.AutoFit 'Formatiert selektierte Spalten in optimale Breite
End Sub
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Access DB Abfrage - Wie ?1.113Boris15.03.04 09:09
Re: Access DB Abfrage - Wie ?655StoneX15.03.04 11:06
Re: Access DB Abfrage - Wie ?637Boris15.03.04 11:20
Re: Access DB Abfrage - Wie ?653StoneX15.03.04 11:54
Re: Access DB Abfrage - Wie ?646Boris15.03.04 12:36
Re: Access DB Abfrage - Wie ?610StoneX15.03.04 13:04
Re: Access DB Abfrage - Wie ?600Boris15.03.04 13:50
Re: Access DB Abfrage - Wie ?612Prian081515.03.04 13:17
Re: Access DB Abfrage - Wie ?616Boris30.03.04 11:58
Re: Access DB Abfrage - Wie ?722Prian081530.03.04 12:42

Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.

Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
  
   

Copyright ©2000-2025 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel