PDA

Vollständige Version anzeigen : Smiley automatisch in neue Tabelle übernehmen


Quartzlurch
14.07.2014, 18:07
Excel 2003; Windows 7

Hallo User,

habe in der folgenden Tabelle ein Problem mit dem automatischen einfügen von Smileys in der Spalte C. Was momentan funktioniert, ist folgendes. Die Spalte "C" ist formatiert mit dem Zeichensatz >Wingdings<. bei Eingabe von "J", "L" oder "ü" erhalte ich die jeweiligen Zeichen: Lachender Smiley, Trauriger Smiley oder Häkchen. Ich möchte nun gerne, dass zum Monatsbeginn, wenn noch keine Daten vorhanden sind, in der Spalte "C" alle Felder mit dem Traurigen Smiley = "Rechnung offen" vorbesetzt sind, die dann mit jeder Bezahlung einer jeden Rechnung per Tastenkombination z. Bsp, "ü" für Häkchen, als bezahlt gekennzeichnet wird.

Habe eine Datei hochgeladen, in "Diese Arbeitsmappe" im Makro-Feld habe ich ansatzweise ein Makro drin. Funktioniert aber nicht!

Konnte in den "Tiefen der Archiven" und im Internet, nichts passendes finden. Hat jemand von euch eine Idee, wie ich's anpacken muss?


Kostenart:...............Betrag:................Zahlung:
A...........................B........................C
Telefon.....................75,00 €
Miete......................900,00 €
Strom/Wasser...........200,00 €
Versicherung1...........100,00 €
Versicherung2...........150,00 €
KFZ-Versicherung......450,00 €
KFZ-Steuer..............120,00 €
Leasingrate..............325,00 €

Mc Santa
14.07.2014, 18:18
Hallo,

meinst du es so?
Sub Smiley_einfügen()
Sheets("Tabelle1").Range("C2:c9") = "L"
End Sub

Ich würde von Activate absehen, aber wenn du es nutzt, dann so: Sheets("Tabelle1").Activate allerdings ist folgender Code besser, falls du tatsächlich einmal die Ansicht ändern willst (macht nur ganz am Ende des Codes Sinn, um es dem User zu erleichtern):
Application.Goto Worksheets("Tabelle1").Cells(1, 1)

VG

Quartzlurch
14.07.2014, 18:31
HI Mc Santa,

ich habe beide Codes ausprobiert, aber die Zellen bleiben leer, was mach ich falsch?

Gruß Horst

Mc Santa
14.07.2014, 18:40
Hallo,

der zweite Code macht auch nichts, außerer die Tabelle für dich in dern Vordergrund zu holen.

Der erste Code jedoch sollte die Zellen befüllen.

erhälst du eine Fehlermeldung?

Quartzlurch
14.07.2014, 18:42
Nein, ich lade die Tabelle, nachdem ich den Code eingegeben habe, speichere ab, schliese die Datei. Beim Öffnen der Datei sind die Felder leer.

Mc Santa
14.07.2014, 18:50
Hallo,

damit der Code automatisch ausgeführt wird, musst du die Funktion entsprechend benennen. Nur mit diesem Namen wird sie beim Öffnen ausgeführt:
Sub Workbook_Open()
Sheets("Tabelle1").Range("C2:c9") = "L"
Application.Goto Sheets("Tabelle1").Cells(1, 1), True
End Sub

VG

Quartzlurch
14.07.2014, 18:56
Hallo Mc Santa,

grundsätzlich funktioniert das jetzt, "Klasse". Einziger Fehler ist:"Die Häkchen die ich für bezahlte Rechnungen setze, werden bei neuem Öffnen der Tabelle wieder mit dem "Traurigen Smiley" überschrieben, das sollte so nicht sein. Bleibt da als einzige Möglichkeit, das Makro über einen >Button< auszulösen?

Gruß Horst

Mc Santa
14.07.2014, 19:06
Es sollen also nur leere Zellen befüllt werden?

Dann so:
Sub Workbook_Open()
Sheets("Tabelle1").Range("C2:c9").SpecialCells(xlCellTypeBlanks) = "L"
Application.Goto Sheets("Tabelle1").Cells(1, 1), True
End Sub

VG

Quartzlurch
14.07.2014, 19:19
Hallo Mc Santa,

also der letzte Code hat die schon gefüllten Zellen beim Öffnen nicht überschrieben, aber das Makro wurde angehalten, mit der Fehlermeldung:"Laufzeitfehler 1004" und "Die SpecialCells-Eigenschaft des Range-Objektes kann nicht festgelegt werden"

Gruß Horst

Mc Santa
14.07.2014, 19:56
Hallo,

der Code gibt einen Fehler, wenn es keine freien Zellen gibt. Eine richtige Fehlerbehandlung habe ich nicht gefunden, daher folgendes:

Sub Workbook_Open()
On Error Resume Next
Range("C2:C9").SpecialCells(xlCellTypeBlanks) = "L"
Application.Goto Sheets("Tabelle1").Cells(1, 1), True
End Sub

VG

Quartzlurch
14.07.2014, 20:10
Hallo Mc Santa,

da bleiben keine Wünsche mehr offen ;-) genau so hatte ich's mir vorgestellt, super. Danke dir für die Hilfe!

Gruß und einen schönen Abend, Horst

Hallo,

der Code gibt einen Fehler, wenn es keine freien Zellen gibt. Eine richtige Fehlerbehandlung habe ich nicht gefunden, daher folgendes:

Sub Workbook_Open()
On Error Resume Next
Range("C2:C9").SpecialCells(xlCellTypeBlanks) = "L"
Application.Goto Sheets("Tabelle1").Cells(1, 1), True
End Sub

VG

Quartzlurch
15.07.2014, 20:25
Hallo Mc Santa,

guten Abend :sos:

Einen Wunsch hätte ich jetzt doch noch zu dem Code:

Sub Workbook_Open()
On Error Resume Next
Range("C2:C9").SpecialCells(xlCellTypeBlanks) = "L"
Application.Goto Sheets("Tabelle1").Cells(1, 1), True
End Sub


Ich habe versucht den letzten Code von dir entsprechend abzuändern, kriege es aber leider nicht gebacken :o

Beim Öffnen der Tabelle sollen die Smileys nur auf den leeren Zellen eingefügt werden (das haben wir bereits), und nur soweit, wie die Zellen in Spalte "B" einen Inhalt haben. Kannst Du nochmal helfen?

Gruß Horst

Mc Santa
15.07.2014, 20:33
Hallo,

folgender Vorschlag:
Private Sub Workbook_Open()
Dim ber as Range, rng as Range
Set ber = Worksheet("Sheet1").Range("C2:C9")

For each rng in ber
If rng.value = "" And rng.offset(, -1).value <> "" Then
rng = "L"
End If
next rng
End Sub

VG

Quartzlurch
15.07.2014, 21:30
Hallo Mc Santa,

nachdem der VBA-Editor gemeckert hatte und das Wort "Worksheet" markierte, habe ich nach einigem überlegen und recherchieren den unten rot markierten Code wie folgt abgeändert: >Worksheets("Tabelle1")< Jetzt funktioniert das ganze tadellos. Herzlichen Dank, und noch einen schönen Abend.

Liebe Grüße Horst :dance: :yelrotfl:

Hallo,

folgender Vorschlag:
Private Sub Workbook_Open()
Dim ber as Range, rng as Range
Set ber = Worksheet("Sheet1").Range("C2:C9")

For each rng in ber
If rng.value = "" And rng.offset(, -1).value <> "" Then
rng = "L"
End If
next rng
End Sub

VG

Mc Santa
15.07.2014, 21:50
Hallo,

jaja Blindprogrammieren undso..

Oder es war ein Test :P

VG

Quartzlurch
15.07.2014, 22:06
Hallo,

jaja Blindprogrammieren undso..

Oder es war ein Test :P

VG

Davon ging ich aus ;-)

LG