|
Tabelle erstellen - Text zentriert formatieren -> Excel
|
| Autor |
Nachricht |
Wolfgang 1958
Trainer
Verfasst am:
25. Dez 2008, 15:34
Rufname: Wolfgang
Wohnort: Geretsried
|
|
| Version: Office 2003 |
|
| Wolfgang 1958 am 25. Dez 2008 um 12:29 hat folgendes geschrieben: | Hallo Fachleute,
mit Euerer Hilfe habe ich es geschaft per VBA eine Tabelle zu erzeugen, die ich später an Excel übergebe (vorher mit einer Funktion per Autoformat) formatiere.
Nun meine Frage:
Ist es möglich bestimmte Felder einer erstellten oder zu erstellenden Tabelle mit einem Format so einzustellen, dass die Textinhalte zentriert sind?
Geht das bei der Tabellenerstellung?
... oder ist so etwas nicht möglich?
Ich freue mich auf Tipps.
Schöne Feiertage noch und
liebe Grüße
Wolfgang |
Hallo Leute,
da mein String nur maximal 3 Zeichen enthält und die Spaltenbreite in Excel sich später an einem Datum mit dem Format "dd-mm" orientiert, habe ich mir mit dem Auffüllen von Leerzeichen vor dem String geholfen.
Mein Code, der bestimmt nicht optimal ist aber funktioniert, schaut so aus:
| Code: | ' hier die Datumsfelder füllen
rs.Edit
For iAnz = 0 To rs.Fields.Count - 1
If rs(iAnz).Name = Format(rTAB!Datum, "dd-mm") Then
If Len(rTAB!Anwesenheit) = Null Then
rs(iAnz) = rs(iAnz) & rTAB!Anwesenheit
ElseIf Len(rTAB!Anwesenheit) = 1 Then
rs(iAnz) = " "
rs(iAnz) = rs(iAnz) & rTAB!Anwesenheit
ElseIf Len(rTAB!Anwesenheit) = 2 Then
rs(iAnz) = " "
rs(iAnz) = rs(iAnz) & rTAB!Anwesenheit
ElseIf Len(rTAB!Anwesenheit) = 3 Then
rs(iAnz) = " "
rs(iAnz) = rs(iAnz) & rTAB!Anwesenheit
End If
End If
Next iAnz
rs.Update |
Falls jemand eine Optimierung für mich hat, freue ich mich darüber.
Nochmals schöne Feiertage und
ciao
Wolfgang
_________________
Ich freue mich über ein Feedback.
|
|
JörgG
Access-Team
Verfasst am:
27. Dez 2008, 12:24
Rufname:
Wohnort: b. Dresden
|
| |
| Version: Office 2003 |
|
Hallo,
so ganz verstehe ich den Code nicht, wozu rödelt denn die Schleife durch alle Felder, wenn der Feldname hier als Format(rTAB!Datum, "dd-mm") feststeht? Ist dieser Feldname immer vorhanden? Schleifen sind ja fast immer kontraproduktiv, probiere es mal ohne Schleife und ohne die vielen IF's (das sollte dann die Optimierung sein  ):
| Code: | rs.Edit
rs("[" & Format(rTAB!Datum, "dd-mm") & "]") = _
Space(10 - Len(Nz(rTAB!Anwesenheit, ""))) & rTAB!Anwesenheit
rs.Update |
 Die 10 wäre die max mögliche Stringlänge, anpassen!
_________________
MfG, Jörg
Bitte das Feedback nicht vergessen.
|
|
SGast
Gast
Verfasst am:
27. Dez 2008, 12:41
Rufname:
|
|
| Version: Office 2003 |
|
Hallo,
ich denke das Leerzeichen auffüllen ist nicht der saubere Weg, schließlich "verunstaltest" du deine Werte.
Formatiere die Spalte, wie ursprünglich vorgesehen ( xlSheet.Range("B:B").HorizontalAlignment = xlCenter):
| Code: | Sub FormatExcelDat(Exceldatnam As String)
Const xlCenter = -4108
Dim xlApp As Object ' Excel.Application
Dim xlBook As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.Worksheet
Const xlRangeAutoFormatSimple = -4154
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(Exceldatnam)
Set xlSheet = xlBook.Worksheets(1)
xlSheet.UsedRange.AutoFormat Format:=xlRangeAutoFormatSimple, _
Number:=True, Font:=True, Alignment:=True, _
Border:=True, Pattern:=True, Width:=True
xlSheet.Range("B:B").HorizontalAlignment = xlCenter
xlBook.Save
xlApp.Application.Quit
End Sub |
Gruß Steffen
|
|
Wolfgang 1958
Trainer
Verfasst am:
21. Feb 2009, 19:03
Rufname: Wolfgang
Wohnort: Geretsried
|
|
| Version: Office 2003 |
|
| Wolfgang 1958 am 27. Dez 2008 um 12:01 hat folgendes geschrieben: | Hallo Jörg,
vielen Dank für Deinen Vorschlag.
Mit Deinem Code komme ich so nicht klar.
Hier meine Ausgangssituation und mein Code:
Ich habe zwei Tabellen für Teilnehmer und für Anwesenheiten. In Teilnehmer stehen die Stammdaten der TNs und in Anwesenheiten stehen DS Tag für Tag für die An- oder Abwesenheit der TNs.
Mit einer Abfrage werden diese beiden Tabellen nun zusammengemischt.
Dann durchlaufe ich sie und erzeuge eine temporäre Tabelle, in dem es nur einen DS für jeden TN gibt und zusätzlich so viele Felder, wie Anwesenheitstage gebucht wurden.
Hier mein Code und der zu optimierende Code ist mit ' ************ gerahmt.
Sicher verstehst Du jetzt, warum ich die Felder in einer Schleife durchlaufe.
| Code: | Private Sub Befehl64_Click()
On Error GoTo Err_Befehl64_Click
Dim tdfNew As DAO.TableDef
Dim tdf As DAO.TableDef
Dim prpLoop As DAO.Property
Dim TblName As String
Dim AktDatum As Date
'Variablen für die Abfrageverarbeitung...
Dim strSQL As String
Dim DB As DAO.Database
Dim rTAB As DAO.Recordset
Dim iAnz As Integer
'Variablen für die Zieltabelle zum Schreiben
Dim rs As DAO.Recordset
'Variablen für XML-Export nach Excel...
Dim objOrderInfo As AdditionalData
Dim objOrderDetailsInfo As AdditionalData
Dim MyDbPath As String
Dim MyDbName As String
Dim MyDbNameNoPath
Dim MyFile
Dim MyTmpPath
If Me.NewRecord Then Exit Sub
' Erst den aktuellen Datensatz speichern!!!
DoCmd.RunCommand acCmdSaveRecord
If Nz(Me!Von, "") = "" And Nz(Me!Bis, "") = "" Then
Me!Von = Me!Kombinationsfeld35
Me!Bis = Me!Kombinationsfeld35
Else
If Nz(Me!Von, "") = "" Then
GoTo ANFANGSFEHLER
Else
If Nz(Me!Bis, "") = "" Then
GoTo ANFANGSFEHLER
End If
End If
End If
If Nz(Me!Bis, "") < Nz(Me!Von, "") Then GoTo ANFANGSFEHLER
'Erzeuge einen eindeutigen Namen für die Neue Tabelle
TblName = "Anwesenheit"
' Vorsichtshalber die Tabelle löschen, falls sie schon vorhanden ist ...
For Each tdf In CurrentDb.TableDefs
If tdf.Name = TblName Then
DoCmd.Close acTable, tdf.Name
DoCmd.DeleteObject acTable, tdf.Name
'MsgBox "Alte Tabelle '" & TblName & _
' "' wird erst gelöscht und dann neu aufgebaut!"
End If
Next tdf
' Erzeuge ein neues Tabellenobjekt
Set tdfNew = CurrentDb.CreateTableDef(TblName)
With tdfNew
' Erzeuge Felder in der neuen Tabelle
.Fields.Append .CreateField("TN", dbText)
.Fields.Append .CreateField("Name", dbText)
.Fields.Append .CreateField("Vorname", dbText)
.Fields.Append .CreateField("geboren", dbDate)
.Fields.Append .CreateField("Nummer", dbText)
' Mit Schleife die Datumsangaben aus der Originaltabelle in Feldnamen
' umsetzen
For AktDatum = Me!Von To Me!Bis
.Fields.Append .CreateField(Format(AktDatum, "dd-mm"), dbText)
Next AktDatum
' Hänge die neue Tabelle an die Datenbank an
CurrentDb.TableDefs.Append tdfNew
End With
' Tabelle fertig erzeugt
' Nun das Füllen der Tabelle...
Set rs = CurrentDb.OpenRecordset(TblName, dbOpenDynaset)
Set DB = CurrentDb()
strSQL = "SELECT T.*, A.* " & _
"FROM Anwesenheiten AS A " & _
"INNER JOIN [TN-Daten] AS T " & _
"ON A.[TN-Nr] = T.Teilnehmernummer " & _
"WHERE A.Datum>= #" & Format(Me!Von, "mm\/dd\/yyyy") & "# " & _
"AND A.Datum<= #" & Format(Me!Bis, "mm\/dd\/yyyy") & "# " & _
"AND T.Aktiv=-1 " & _
"ORDER BY T.Teilnehmername, T.Teilnehmer1Vorname;"
Set rTAB = DB.OpenRecordset(strSQL)
If rTAB.EOF = False Then
rTAB.MoveLast
rTAB.MoveFirst
End If
Do While rTAB.EOF = False
rs.FindFirst "[TN] = '" & rTAB![TN-Nr] & "'"
If Not rs.NoMatch Then
' hier die Datumsfelder füllen
rs.Edit
For iAnz = 0 To rs.Fields.Count - 1
'******************** hier der Code-Teil, den ich optimieren möchte **********
If rs(iAnz).Name = Format(rTAB!Datum, "dd-mm") Then
If Len(rTAB!Anwesenheit) = Null Then
rs(iAnz) = rs(iAnz) & rTAB!Anwesenheit
ElseIf Len(rTAB!Anwesenheit) = 1 Then
rs(iAnz) = " "
rs(iAnz) = rs(iAnz) & rTAB!Anwesenheit
ElseIf Len(rTAB!Anwesenheit) = 2 Then
rs(iAnz) = " "
rs(iAnz) = rs(iAnz) & rTAB!Anwesenheit
ElseIf Len(rTAB!Anwesenheit) = 3 Then
rs(iAnz) = " "
rs(iAnz) = rs(iAnz) & rTAB!Anwesenheit
End If
End If
'********************* hier der Code-Teil, den ich optimieren möchte *********
Next iAnz
rs.Update
Else
rs.AddNew
rs![TN] = rTAB![TN-Nr]
rs!Name = rTAB!Teilnehmername
rs!Vorname = rTAB!Teilnehmer1Vorname
rs!geboren = rTAB!Geburtsdatum
rs!Nummer = rTAB!Kundennummer
For iAnz = 0 To rs.Fields.Count - 1
If rs(iAnz).Name = Format(rTAB!Datum, "dd-mm") Then
If Len(rTAB!Anwesenheit) = Null Then
rs(iAnz) = rs(iAnz) & rTAB!Anwesenheit
ElseIf Len(rTAB!Anwesenheit) = 1 Then
rs(iAnz) = " "
rs(iAnz) = rs(iAnz) & rTAB!Anwesenheit
ElseIf Len(rTAB!Anwesenheit) = 2 Then
rs(iAnz) = " "
rs(iAnz) = rs(iAnz) & rTAB!Anwesenheit
ElseIf Len(rTAB!Anwesenheit) = 3 Then
rs(iAnz) = " "
rs(iAnz) = rs(iAnz) & rTAB!Anwesenheit
End If
End If
Next iAnz
rs.Update
End If
rTAB.MoveNext
Loop
rTAB.Close
rs.Close
' ------------------------------------------------------------------------
' Jetzt kommt der Teil, der die Tabelle nach Excel exportiert
' Pfad der Datenbank ermitteln...
DoCmd.Requery
' Pfad der Datenbank ermitteln...
MyDbName = CurrentDb.Name
MyDbNameNoPath = Mid(Mid(MyDbName, InStrRev(MyDbName, "\") + 1), 1, _
Len(Mid(MyDbName, _
InStrRev(MyDbName, "\") + 1)) - 4) & ".mdb"
MyDbPath = Left(MyDbName, Len(MyDbName) - Len(MyDbNameNoPath))
MyFile = MyDbPath & "AW-Liste.xls"
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(MyFile) = True Then
Kill MyFile
End If
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, TblName, _
MyFile, True
For Each tdf In CurrentDb.TableDefs
If tdf.Name = TblName Then
DoCmd.Close acTable, tdf.Name
DoCmd.DeleteObject acTable, tdf.Name
' MsgBox "Alte Tabelle '" & TblName & _
' "' wird erst gelöscht und dann neu aufgebaut!"
End If
Next tdf
'Aufruf der Excel-Datei-Formatfunkiton
FormatExcelDat vrtSelectedItem & MyFile
'Messagebox ob Exceldatei geöfnet werden soll
Antw = MsgBox("AW-Liste.xls öffnen?", vbYesNo, _
"Adresstabelle erstellt...")
If Antw = vbYes Then
dummy = ShellExecute(0, vbNullString, MyFile, vbNullString, _
vbNullString, 1)
End If
GoTo ENDE:
ANFANGSFEHLER:
MsgBox "Keine gültigen Datumsangaben"
ENDE:
Exit_Befehl64_Click:
Exit Sub
Err_Befehl64_Click:
MsgBox Err.Description
Resume Exit_Befehl64_Click
End Sub |
Ich habe veruscht Deinen Code anzupassen und statt der Ifs einzubauen, aber es kommt zu einer Datenunverträglichkeit.
Vielleicht hast Du noch einen Tipp?
Vielen Dank für Deine bisherige Hilfe und
liebe Grüße
Wolfgang |
| Wolfgang 1958 am 27. Dez 2008 um 12:03 hat folgendes geschrieben: | Hallo Steffen,
Dein Ansatz könnte auch nicht falsch sein. Vielen Dank hierfür.
Ich müßte jedoch die Spalten F bis IV als zentriert formatieren.
Dein Code:
| Code: | | xlSheet.Range("B:B").HorizontalAlignment = xlCenter |
Ich versuchte
| Code: | | xlSheet.Range("F:IV").HorizontalAlignment = xlCenter |
Das führte zu der Fehlermeldung, dass der horizontale Range nicht möglich sei.
Dann der nächste Versuch nur mit der Spalte F
| Code: | | xlSheet.Range("F:F").HorizontalAlignment = xlCenter |
Hier wurde dann der Zugriff verweigert
Hast Du vielleicht hier eine Lösung in der Excel-Prozedur. Das wäre wahrscheinlich die eleganteste Lösung, denke ich.
Ciao
Wolfgang |
| Wolfgang 1958 am 27. Dez 2008 um 12:06 hat folgendes geschrieben: | Hallo Steffen,
Kommando zurück!!!!
Es funktioniert doch mit:
| Code: | | xlSheet.Range("F:IV").HorizontalAlignment = xlCenter |
Ich hatte nur die Constante xlCenter übersehen.
Kaum habe ich sie eingefügt, geht alles.
Natürlich mußte ich noch den Code bei der Feldbefüllung ändern:
| Code: | Do While rTAB.EOF = False
rs.FindFirst "[TN] = '" & rTAB![TN-Nr] & "'"
If Not rs.NoMatch Then
' hier die Datumsfelder füllen
rs.Edit
For iAnz = 0 To rs.Fields.Count - 1
If rs(iAnz).Name = Format(rTAB!Datum, "dd-mm") Then
rs(iAnz) = rTAB!Anwesenheit
End If
Next iAnz
rs.Update
Else
rs.AddNew
rs![TN] = rTAB![TN-Nr]
rs!Name = rTAB!Teilnehmername
rs!Vorname = rTAB!Teilnehmer1Vorname
rs!geboren = rTAB!Geburtsdatum
rs!Nummer = rTAB!Kundennummer
For iAnz = 0 To rs.Fields.Count - 1
If rs(iAnz).Name = Format(rTAB!Datum, "dd-mm") Then
rs(iAnz) = rTAB!Anwesenheit
End If
Next iAnz
rs.Update
End If
rTAB.MoveNext
Loop |
Nochmals lieben Dank für Deinen Tipp.
Schönes Wochenende und einen guten Rutsch für alle Helfenden.
Liebe Grüße
Wolfgang |
Hallo Steffen,
noch eine Frage zu diesem Thema:
Ich erzeuge, dank Deiner Hilfe, eine Exceltabelle mit folgendem Funktionsaufruf:
| Code: | | FormatExcelDat vrtSelectedItem & MyFile |
und folgender Funktion:
| Code: | Public Function FormatExcelDat(Exceldatnam As String)
Const xlCenter = -4108
Dim xlApp As Object ' Excel.Application
Dim xlBook As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.Worksheet
Const xlRangeAutoFormatSimple = -4154
On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
On Error GoTo 0
Set xlBook = xlApp.Workbooks.Open(Exceldatnam)
Set xlSheet = xlBook.Worksheets(1)
xlSheet.UsedRange.AutoFormat Format:=xlRangeAutoFormatSimple, _
Number:=True, Font:=True, Alignment:=True, Border:=True, _
Pattern:=True, Width:=True
xlSheet.Range("F:IV").HorizontalAlignment = xlCenter
xlSheet.Range("A:A").HorizontalAlignment = xlCenter
xlBook.Save
xlApp.Application.Quit
End Function |
Nun habe ich den Tabellenaufbau so geändert, dass die Datumsangaben mit YY/MM/DD als Feldüberschriften vorhanden sind, weil ich dieses Format brauchte, um das Datum vernünftig zu sortieren und Kursttermine außerhalb des Kurszeitraums mit einem "-" zu versehen.
Meine Frage nun an Dich, weil ich mit Excel-VBA absolut noch nichts am Hut habe:
Ist es möglich die Datumsangaben wieder so zu formatieren, dass nur noch die Tagesangabe übrigbleibt? "TT"
Es wäre außerdem auch toll, wenn man noch eine Überschrift in Zelle A1 einfügen könnte - so was wie, "Anwesenheiten von Datum bis Datum".
Damit mein Anliegen besser zu verstehen ist, lade ich außerdem noch die mit Deiner Funktion formatierte Excel-Tabelle hoch.
Ich würde mich freuen, wenn Du mir noch die eine oder andere Idee hast.
Schöne Faschingstage und
ciao
Wolfgang
_________________
Ich freue mich über ein Feedback.
| Beschreibung: |
|
Download |
| Dateiname: |
AW-Liste.zip |
| Dateigröße: |
7.52 KB |
| Heruntergeladen: |
11 mal |
|
|
steffen0815
VBA-Programmierer
Verfasst am:
22. Feb 2009, 12:00
Rufname: Steffen
Wohnort: bei Dresden
|
| |
| Version: Office 2003 |
|
Hallo Wolfgang,
| Zitat: | | dass die Datumsangaben mit YY/MM/DD als Feldüberschriften vorhanden sind, weil ich dieses Format brauchte, um das Datum vernünftig zu sortieren |
Wo brauchst du diese Formatierung?
In der Exceltabelle selbst ist das Datum "zerstört", das heißt es ist ein Text und lässt sich nicht als "TT" formatieren. Um das zu erreichen müsste es wieder als richtiges Datum umgeschrieben werden.
| Zitat: | | Es wäre außerdem auch toll, wenn man noch eine Überschrift in Zelle A1 einfügen könnte - so was wie, "Anwesenheiten von Datum bis Datum". |
| Code: | xlSheet.Range("A1") = "Anwesenheiten von Datum bis Datum"
' bzw. mit Formularfeldern
xlSheet.Range("A1") = "Anwesenheiten von " & Me!Datum1 & " bis " & Me!Datum2 |
_________________
Gruß Steffen
|
|
Wolfgang 1958
Trainer
Verfasst am:
22. Feb 2009, 12:27
Rufname: Wolfgang
Wohnort: Geretsried
|
|
| Version: Office 2003 |
|
Hallo Stefen,
vielen Dank für Deine schnelle Reaktion.
mit
| Code: | | xlSheet.Range("A1") = "Anwesenheiten von " & Me!Datum1 & " bis " & Me!Datum2 |
überschreibe ich die Zelle A1.
Das hatte ich nicht vor. Aber damit weiß ich jetzt, wie ich die einzelnen Tabellenzellen überschreiben kann. Das könnte mir bei dem Vorhaben alle
Zellüberschriften, die ein Datum enthalten zu durchlaufen und zu überschreiben.
Hast Du mir vielleicht noch einen Tipp, wie ich die Überschrift nicht in die Zelle A1 (war von mir falsch beschrieben) hineinbekomme, sondern wie ich eine Zeile einfügen kann und dann die Überschrift hineinbekomme
oder noch besser, wie ich die Überschrift in die Kopfzeile bekomme?
Nochmals danke für Deine super Hilfestellungen. Ohne Dich wäre ich hiermit nie so weit gekommen.
Liebe Grüße aus Geretsried
Wolfgang
| Nachtrag: Wolfgang 1958 am 22. Feb 2009 um 11:36 hat folgendes geschrieben: | Hallo Steffen,
in excel habe ich gerade probiert, wie man die letzten zwei Zeichen der Überschrift bekommt.
Zum Beispiel die letzten 2 Buchstaben der Zelle F1 =TEIL(F1;7;2)
Kann ich diese Formel evtl. auf meine Überschriften anwenden?
Die erstel Überschriftposition ist bekannt und wenn ich z. B. von F1 bis ... diese Funktion irgendwie anwenden könnte, wäre das die Lösung, oder liege ich da falsch?
Nochmals Danke und
ciao
Wolfgang |
_________________
Ich freue mich über ein Feedback.
|
|
steffen0815
VBA-Programmierer
Verfasst am:
22. Feb 2009, 13:51
Rufname: Steffen
Wohnort: bei Dresden
|
|
| Version: Office 2003 |
|
Hallo Wolfgang,
hier erst mal der Part mit der Kopfzeile: | Code: | With xlSheet.PageSetup
.LeftHeader = "Kopf links"
.CenterHeader = "Kopf mitte"
.RightHeader = "Kopf rechts"
End With |
Für die Überschrift wäre zu überlegen, das richtige Datum zu nutzen und auf TT zu formatieren: | Code: | ' ...
Dim s As Integer ' Spaltenzähler
Dim Datum As Date
' ...
For s = 1 To 254
' Wenn nix drin steht, dann raus aus der Schleife
If xlSheet.Cells(1, s) = "" Then Exit For
' was machen wenn ein "/" in der Überschrift
If InStr(xlSheet.Cells(1, s), "/") Then
' Datum wieder zusammenbauen
Datum = CDate(Mid(xlSheet.Cells(1, s), 7, 2) & "." & _
Mid(xlSheet.Cells(1, s), 4, 2) & "." & _
Mid(xlSheet.Cells(1, s), 1, 2))
' Zelle formatieren
xlSheet.Cells(1, s).NumberFormat = "dd"
' Datum schreiben
xlSheet.Cells(1, s) = Datum
End If
Next s |
_________________
Gruß Steffen
|
|
Wolfgang 1958
Trainer
Verfasst am:
22. Feb 2009, 14:33
Rufname: Wolfgang
Wohnort: Geretsried
|
|
| Version: Office 2003 |
|
Hallo Steffen,
vielen lieben Dank für die fast 100%-tig perfekte Lösung.
Hier mein (Dein) Code:
| Code: | Public Function FormatExcelDat(Exceldatnam As String)
Const xlCenter = -4108
Dim xlApp As Object ' Excel.Application
Dim xlBook As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.Worksheet
Dim s As Integer ' Spaltenzähler
Dim Datum As Date
Const xlRangeAutoFormatSimple = -4154
On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
On Error GoTo 0
Set xlBook = xlApp.Workbooks.Open(Exceldatnam)
Set xlSheet = xlBook.Worksheets(1)
xlSheet.UsedRange.AutoFormat Format:=xlRangeAutoFormatSimple, _
Number:=True, Font:=True, Alignment:=True, Border:=True, _
Pattern:=True, Width:=True
With xlSheet.PageSetup
'.LeftHeader = "Kopf links"
.CenterHeader = "Anwesenheitsliste"
'.RightHeader = "Kopf rechts"
End With
For s = 7 To 249
' Wenn nix drin steht, dann raus aus der Schleife
If xlSheet.Cells(1, s) = "" Then Exit For
' was machen wenn ein "/" in der Überschrift
If InStr(xlSheet.Cells(1, s), "/") Then
' Datum wieder zusammenbauen
Datum = CDate(Mid(xlSheet.Cells(1, s), 7, 2) & "." & _
Mid(xlSheet.Cells(1, s), 4, 2) & "." & _
Mid(xlSheet.Cells(1, s), 1, 2))
' Zelle formatieren
xlSheet.Cells(1, s).NumberFormat = "dd"
' Datum schreiben
xlSheet.Cells(1, s) = Datum
End If
Next s
xlSheet.Range("F:IV").HorizontalAlignment = xlCenter
xlSheet.Range("A:A").HorizontalAlignment = xlCenter
xlBook.Save
xlApp.Application.Quit
End Function |
Eine Kleinigkeit bleibt noch ungelöst. Nun sind die Spalten mit den Datumsangaben nicht mehr auf "optimale Spaltenbreite" eingestellt.
Wo habe ich den Fehler gemacht. Habe ich den Code an einer falschen Stelle integriert?
Nochmals vielen lieben Dank und noch einen schönen Sonntag.
Ciao
Wolfgang
_________________
Ich freue mich über ein Feedback.
|
|
steffen0815
VBA-Programmierer
Verfasst am:
22. Feb 2009, 14:39
Rufname: Steffen
Wohnort: bei Dresden
|
|
| Version: Office 2003 |
|
Hallo,
| Zitat: | | Wo habe ich den Fehler gemacht. Habe ich den Code an einer falschen Stelle integriert? |
Ja  , du solltest erst die Werte setzen und dann formatieren.
Der Formatierungsbefehl ist der "xlSheet.UsedRange.AutoFormat ...."
>> noch einen schönen Sonntag
Danke, dir auch. Ich ersticke nur leider fast im Schnee 
Btw: | Code: | On Error Resume Next ' -> raus damit
Set xlApp = CreateObject("Excel.Application")
On Error GoTo 0 ' -> raus damit |
Diese Fehlerbehandlung ist überflüssig. Kann so raus und sollte (irgendwann) durch eine ordentliche Fehlerbehandlung ersetzt werden.
_________________
Gruß Steffen
|
|
Wolfgang 1958
Trainer
Verfasst am:
20. Feb 2010, 05:30
Rufname: Wolfgang
Wohnort: Geretsried
|
|
| Version: Office 2003 |
|
| Zitat: | Hallo Steffen,
super, jetzt funktioniert alles.
Ich danke nochmals von ganzem Herzen für Deine überaus proffesionelle Hilfe.
Auch uns geht es so. Wir versinken auch im Schnee.
Nochmals alles Gute und
liebe Grüße aus dem Oberland
Wolfgang |
| Wolfgang 1958 am 22. Feb 2009 um 13:44 hat folgendes geschrieben: | Hallo Steffen, hallo an alle Interessierten,
hier noch der entgültige Code zur Formatierung der Excel-Datei (Anwesenheitsliste):
| Code: | Public Function FormatExcelDat(Exceldatnam As String, Headline As String)
Const xlCenter = -4108
Dim xlApp As Object ' Excel.Application
Dim xlBook As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.Worksheet
Dim s As Integer ' Spaltenzähler
Dim Datum As Date
Const xlRangeAutoFormatSimple = -4154
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(Exceldatnam)
Set xlSheet = xlBook.Worksheets(1)
With xlSheet.PageSetup
'.LeftHeader = "Kopf links"
.CenterHeader = Headline
'.RightHeader = "Kopf rechts"
End With
For s = 1 To 249
' Wenn nix drin steht, dann raus aus der Schleife
If xlSheet.Cells(1, s) = "" Then Exit For
' was machen wenn ein "/" in der Überschrift
If InStr(xlSheet.Cells(1, s), "/") Then
' Datum wieder zusammenbauen
Datum = CDate(Mid(xlSheet.Cells(1, s), 7, 2) & "." & _
Mid(xlSheet.Cells(1, s), 4, 2) & "." & _
Mid(xlSheet.Cells(1, s), 1, 2))
' Zelle formatieren
xlSheet.Cells(1, s).NumberFormat = "dd"
' Datum schreiben
xlSheet.Cells(1, s) = Datum
End If
Next s
xlSheet.UsedRange.AutoFormat Format:=xlRangeAutoFormatSimple, _
Number:=True, Font:=True, Alignment:=True, Border:=True, _
Pattern:=True, Width:=True
xlSheet.Range("F:IV").HorizontalAlignment = xlCenter
xlSheet.Range("A:A").HorizontalAlignment = xlCenter
xlBook.Save
xlApp.Application.Quit
End Function |
Viel Spaß beim Nachvollziehen und
ciao
Wolfgang |
Hallo Fachleute,
ich versuche gerade meinen Code für die Excel-Tabellenformatierung zu erweitern. Ich wollte bedingte Formatierungen einfügen und scheitere voll.
Was mache ich falsch?
Ich setze am Ende folgenden Code ein:
| Code: | xlSheet.UsedRange.AutoFormat Format:=xlRangeAutoFormatSimple, _
Number:=True, Font:=True, Alignment:=True, Border:=True, _
Pattern:=True, Width:=True
xlSheet.Range("F:IV").HorizontalAlignment = xlCenter
xlSheet.Range("A:B").HorizontalAlignment = xlCenter
' Mein neuer nicht funktionierender Code...
' Samstag gelb und fette Schrift
xlSheet.UsedRange.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=WENN(WOCHENTAG(A$1) = 7; WAHR(); FALSCH())"
xlSheet.UsedRange.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With xlSheet.UsedRange.FormatConditions(1).Font
.Bold = True
.Italic = False
.TintAndShade = 0
End With
With xlSheet.UsedRange.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
xlSheet.UsedRange.FormatConditions(1).StopIfTrue = True
' Sonntag rot, weiße Schrift und fett
xlSheet.UsedRange.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=WENN(WOCHENTAG(A$1) = 1; WAHR(); FALSCH())"
xlSheet.UsedRange.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With xlSheet.UsedRange.FormatConditions(1).Font
.Bold = True
.Italic = False
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With xlSheet.UsedRange.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
xlSheet.UsedRange.FormatConditions(1).StopIfTrue = True
' Ende meines neuen nicht funktionierenden Codes...
xlBook.Save
xlApp.Application.Quit |
Ich habe den Code in Excel mit "Makro aufzeichnen" erstellen lassen und versucht ihn anzupassen. Der Code beim Makro aufzeichnen sah so aus:
| Code: | ' Samstag gelb und fette Schrift
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=WENN(WOCHENTAG(A$1) = 7; WAHR(); FALSCH())"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
' Sonntag rot, weiße Schrift und fett
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=WENN(WOCHENTAG(A$1) = 1; WAHR(); FALSCH())"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True |
Was mache ich falsch?
Ich würde mich über Tips von Euch freuen.
Liebe Grüße aus dem Oberland
Wolfgang
_________________
Ich freue mich über ein Feedback.
|
|
steffen0815
VBA-Programmierer
Verfasst am:
20. Feb 2010, 10:59
Rufname: Steffen
Wohnort: bei Dresden
|
|
| Version: Office 2003 |
|
Hallo,
so lang noch unverwiesene Selection im Code sind kann es nicht richtig funktionieren.
Eigentlich sollten alle Selection aufgelöst werden und dies am Besten schon in Excel.
Danach in Access alle restlichen Excelobjekte verweisen.
.... und zur Sicherheit: steht über dem Modul!?
_________________
Gruß Steffen
|
|
Wolfgang 1958
Trainer
Verfasst am:
20. Feb 2010, 11:07
Rufname: Wolfgang
Wohnort: Geretsried
|
|
| Version: Office 2003 |
|
Hallo Steffen,
danke für Deine Antwort.
Was meinst Du mit "unverwiesene Selection"?
Ich habe die Konstanten, die im Code drin waren einmal durch die entsprechenden Werte ersetzt. Der gesamte Code (nicht funktionierender Code in ' *****) schaut jetzt so aus:
| Code: | Public Function FormatExcelDat(Exceldatnam As String, Headline As String)
Const xlCenter = -4108
Dim xlApp As Object ' Excel.Application
Dim xlBook As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.Worksheet
Dim S As Integer ' Spaltenzähler
Dim Datum As Date
'Const xlRangeAutoFormatSimple = -4154
Const xlRangeAutoFormatSimple = 12
Const xlLandscape = 2
Const Rand = 27 ' entspricht ca. 1 cm
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.workbooks.Open(Exceldatnam)
Set xlSheet = xlBook.Worksheets(1)
With xlSheet.PageSetup
'.LeftHeader = "Kopf links"
.CenterHeader = "&16" & Headline
'.RightHeader = "Kopf rechts"
' Horizontal und Vertikal zentrieren
'.CenterHorizontally = True
'.CenterVertically = True
' Hier wird die Seite auf Querformat gestellt...
.Orientation = xlLandscape
' Hier werden die Seitenränder eingestellt...
.LeftMargin = Rand
.RightMargin = Rand
.TopMargin = Rand / 2 * 3
.BottomMargin = Rand
.HeaderMargin = Rand / 2
.FooterMargin = Rand / 2
End With
For S = 1 To 249
' Wenn nix drin steht, dann raus aus der Schleife
If xlSheet.cells(1, S) = "" Then Exit For
' was machen wenn ein "/" in der Überschrift
If InStr(xlSheet.cells(1, S), "/") Then
' Datum wieder zusammenbauen
Datum = CDate(Mid(xlSheet.cells(1, S), 7, 2) & "." & _
Mid(xlSheet.cells(1, S), 4, 2) & "." & _
Mid(xlSheet.cells(1, S), 1, 2))
' Zelle formatieren
xlSheet.cells(1, S).NumberFormat = "dd"
' Datum schreiben
xlSheet.cells(1, S) = Datum
End If
Next S
xlSheet.UsedRange.AutoFormat Format:=xlRangeAutoFormatSimple, _
Number:=True, Font:=True, Alignment:=True, Border:=True, _
Pattern:=True, Width:=True
xlSheet.Range("F:IV").HorizontalAlignment = xlCenter
xlSheet.Range("A:B").HorizontalAlignment = xlCenter
' **********************************************************
' Samstag gelb und fette Schrift
xlSheet.UsedRange.FormatConditions.Add Type:=2, Formula1:= _
"=WENN(WOCHENTAG(A$1) = 7; WAHR(); FALSCH())"
xlSheet.UsedRange.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With xlSheet.UsedRange.FormatConditions(1).Font
.Bold = True
.Italic = False
.ThemeColor = 1
.TintAndShade = 0
End With
With xlSheet.UsedRange.FormatConditions(1).Interior
.PatternColorIndex = -4105
.Color = 65535
.TintAndShade = 0
End With
xlSheet.UsedRange.FormatConditions(1).StopIfTrue = True
' Sonntag rot, weiße Schrift und fett
SxlSheet.UsedRange.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=WENN(WOCHENTAG(A$1) = 1; WAHR(); FALSCH())"
xlSheet.UsedRange.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With xlSheet.UsedRange.FormatConditions(1).Font
.Bold = True
.Italic = False
.ThemeColor = 1
.TintAndShade = 0
End With
With xlSheet.UsedRange.FormatConditions(1).Interior
.PatternColorIndex = -4105
.Color = 255
.TintAndShade = 0
End With
xlSheet.UsedRange.FormatConditions(1).StopIfTrue = True
' *************************************************************
xlBook.Save
xlApp.Application.Quit
End Function |
Es wird aber immer noch eine Fehlermeldung gebracht - so was wie "Fehlendes Objekt".
Ich würde die bedingte Formatierung gerne hier im VBA-Code lösen und zwar auf den in Excel verwendeten Bereich.
Was mache ich noch falsch?
_________________
Ich freue mich über ein Feedback.
|
|
Gast
Verfasst am:
20. Feb 2010, 11:12
Rufname:
|
|
| Version: Office 2003 |
|
Hallo,
zum Beispiel. | Zitat: | | xlSheet.UsedRange.FormatConditions(Selection.FormatConditions.Count) |
Selection ist ein Excelmethode des Application-Objektes und kann so "blank" nicht in Access genutzt werden.
Du solltest bereits in Excel das "Selection" durch den Bereich ersetzen.
Aus deinem Excelcode kann ich nicht erkennen, welcher Bereich Selection darstellt.
Mein Rat: erst in Excel optimieren und dann nach Access. Also einen Schritt zurück.
Ja und wie ist das nun mit "option explicit" und in welcher Zeile tritt der Fehler auf (wobei du solltest den Code ja erst in Excel optimieren)
|
|
Wolfgang 1958
Trainer
Verfasst am:
20. Feb 2010, 11:35
Rufname: Wolfgang
Wohnort: Geretsried
|
|
| Version: Office 2003 |
|
| Wolfgang 1958 am 20. Feb 2010 um 10:24 hat folgendes geschrieben: | Hallo Gast,
vielen Dank für die Tipps.
Das "Option Explicit" ist nun drin.
Nun stoppt VBA und zeigt an, dass Selection nicht definiert ist.
Wie kann ich nun Selection mit dem aktuell in Excel verwendeten Bereich belegen?
Ich habe keine Ahnung!
Übrigens, der Code, der in Excel lief, steht etwas höher. Diesen versuche ich ja gerade an ACCESS-VBA anzupassen.
Noch jemand eine Idee
Ich würde mich über weitere Tipps freuen.
Liebe Grüße aus dem Oberland
Wolfgang |
Hallo Leute,
vielen Dank für Euere Tipps, alle haben mich ein wenig weiter gebracht.
Nach einigem Probieren funktioniert der Code nun. Hier das Ergebnis:
| Code: | ' Samstag gelb und fette Schrift
xlSheet.UsedRange.FormatConditions.Add Type:=2, Formula1:= _
"=WENN(WOCHENTAG(A$1) = 7; WAHR(); FALSCH())"
xlSheet.UsedRange.FormatConditions(xlSheet.UsedRange.FormatConditions.Count).SetFirstPriority
With xlSheet.UsedRange.FormatConditions(1).Font
.Bold = True
.Italic = False
.ThemeColor = 1
.TintAndShade = 0
End With
With xlSheet.UsedRange.FormatConditions(1).Interior
.PatternColorIndex = -4105
.Color = 65535
.TintAndShade = 0
End With
xlSheet.UsedRange.FormatConditions(1).StopIfTrue = True
' Sonntag rot, weiße Schrift und fett
xlSheet.UsedRange.FormatConditions.Add Type:=2, Formula1:= _
"=WENN(WOCHENTAG(A$1) = 1; WAHR(); FALSCH())"
xlSheet.UsedRange.FormatConditions(xlSheet.UsedRange.FormatConditions.Count).SetFirstPriority
With xlSheet.UsedRange.FormatConditions(1).Font
.Bold = True
.Italic = False
.ThemeColor = 1
.TintAndShade = 0
End With
With xlSheet.UsedRange.FormatConditions(1).Interior
.PatternColorIndex = -4105
.Color = 255
.TintAndShade = 0
End With
xlSheet.UsedRange.FormatConditions(1).StopIfTrue = True |
Danke nochmals für Euere Hilfe
Ciao
Wolfgang
_________________
Ich freue mich über ein Feedback.
|
|
steffen0815
VBA-Programmierer
Verfasst am:
20. Feb 2010, 11:40
Rufname: Steffen
Wohnort: bei Dresden
|
| |
| Version: Office 2003 |
|
Hallo,
aber xl2003-Code ist das nicht. Wollte schon fast mein Excel löschen, weil es bei mir nicht funktioniert .
Mit deinem Code machst du dir es etwas schwer. Du solltest mehr mit with arbeiten. Auch solltest du (meiner meinung nach) die Konstanten definieren und nicht einfach durch den Wert ersetzen.:
| Code: | Const xlExpression = 2
Const xlAutomatic = -4105
Const xlThemeColorDark1 = 1
' ....
' Samstag gelb und fette Schrift
With xlSheet.UsedRange
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=WENN(WOCHENTAG(A$1) = 7; WAHR(); FALSCH())"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.TintAndShade = 0
End With
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = True
' Sonntag rot, weiße Schrift und fett
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=WENN(WOCHENTAG(A$1) = 1; WAHR(); FALSCH())"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = True
End With |
_________________
Gruß Steffen
|
|
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen
|
| |
|
|
| Verwandte Themen |
| Forum / Themen |
Antworten |
Autor |
Aufrufe |
Letzter Beitrag |
 |
Access Hilfe: Formular erstellen mit Filterung von Daten |
3 |
Tiger121286 |
114 |
13. Mai 2010, 20:00
Nouba  |
|
Access Tabellen & Abfragen: Tabelle am entfernten SQL-Server ändern |
2 |
Tutti73 |
110 |
26. Apr 2010, 10:39
Tutti73 |
|
Access Formulare: Zeileninhalt einer Tabelle als Spalten im Formular anzeigen |
0 |
MichaelHB |
124 |
06. Apr 2010, 11:18
MichaelHB |
|
Access Formulare: ein einziges Suchfeld erstellen + highlight? |
1 |
daizy |
115 |
02. Nov 2009, 18:38
MiLie |
|
Access Programmierung / VBA: Abfrage als Pivot Tabelle an Email anhängen |
1 |
4pandora4 |
307 |
03. Aug 2009, 15:52
Habichnich |
|
Access Tabellen & Abfragen: Text in Spalten nach fixen Komma |
1 |
kindlicherkaiser |
411 |
03. Feb 2009, 22:22
derArb |
|
Access Programmierung / VBA: Datei aus Excel in access Tabelle importieren |
7 |
access Newbie |
1543 |
08. Aug 2008, 15:41
access Newbie |
|
Access Tabellen & Abfragen: Temporäre Tabelle in Access erzeugen |
32 |
carina0001 |
6944 |
24. Jul 2008, 14:41
leenas |
|
Access Formulare: hyperlink aus tabelle mit bild im formular verknüpfen |
0 |
unbekannt2 |
1027 |
30. Apr 2008, 14:49
unbekannt2 |
|
Access Berichte: komplexes Säulendiagramm erstellen... |
16 |
Gek |
2551 |
12. Feb 2008, 14:25
Gek |
|
Access Tabellen & Abfragen: Pivot Tabelle drucken |
1 |
FlorianWein |
1844 |
27. Jul 2007, 12:40
datroc |
|
Access Hilfe: Berechtigung zum Ändern der Tabelle |
0 |
stachelschwein |
307 |
27. Jun 2007, 09:02
stachelschwein |
| |
|
