Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

suche makro für druck und automatischer kd-nr





Frage

hallo ein zweitesmal für heute ;o) suche zwei sachen, die mir das benützen von excel leichter machen. einmal suche ich ein makro, für meine tabelle12, das mir, wenn ich in spalte A (ab zeile 6) einen datensatz eintippe, in spalte K der gleichen zeile automatisch eine fortlaufende kundennummer verpasst die sich nur ändern lässt wenn ich sie komplett lösche . das zweite makro soll mir per button in tabelle12 nur die spalten B - D und J drucken ab zeile 6 und bei jeder neu zudruckenden seite den gleichen kopf, die zeilen 2 und 3 haben. ich bedanke mich schonmal artig und wünsche eine gute nacht internette grüsse mick

Antwort 1 von coros

Hi mick,

nachfolgend 2 VBA-Code und ein Makro, die das erledigen sollten, was Du Dir erhofft hast. Kopiere nachfolgenden VBA Code in das VBA Projekt des Tabellenblattes, in dem die Kundennummer automatisch fortlaufend erzeugt werden soll.

Option Explicit
Public Textlänge As Integer, Text

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Target.Column = 1 And Target.Row > 6 And Target.Cells <> "" Then
Cells(Target.Row, 11) = Cells(Target.Row - 1, 11) + 1
Application.EnableEvents = True
Exit Sub
End If
If Target.Column = 11 And Textlänge > 0 Then
Textlänge = Len(Target.Cells)
If Target.Column = 11 And Textlänge = 0 Then
Application.EnableEvents = True
Exit Sub
Else
MsgBox "Zum Ändern der KD-Nummer muss die gesamte Nummer gelöscht werden", vbInformation, "Meldung..."
Target.Cells = Text
End If
End If
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Textlänge = Len(Target.Cells)
Text = Target.Cells
End Sub

Mit dem Code wird, wenn ich Spalte A etwas eingegeben wird, in Spalte K eine KD-Nummer fortlaufend erzeugt. Da Du nicht geschrieben hast, ob Du immer Zeilenweise arbeitest, also ohne dass zwischen den einzelnen Eingaben Leerzeilen entstehen könnten, bin ich von dem einfachsten Fall ausgegangen, dass immer in jeder Zelle in Spalte A ein Eintrag erfolgen wird. Wenn nicht, muss der Code noch abgeändert werden.

Kopiere dann nachfolgendes Makro in ein StandardModul und starte es über eine Schaltfläche.

Option Explicit

Sub Drucken()
Dim letzte_Zeile As Long
With ActiveSheet.PageSetup
    .PrintTitleRows = "$2:$3"
End With
letzte_Zeile = ActiveSheet.UsedRange.Rows.Count
Range("B6:D" & letzte_Zeile & ",J6:J" & letzte_Zeile).PrintOut
End Sub

Mit dem Makro wird Dir auf dem aktuellen Drucker die Spalten B bis D un J ab Zeile 6 bis zur letzten Zeile ausgedruckt. Außerdem werden Zeile 2 und 3 als Wiederholungszeilen eingestellt.

Ich hoffe, das ist so, wie Du es Dir vorgestellt hast und das Du klar kommst. Bei Fragen melde Dich bitte.

Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 2 und 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 2 von ponscho

hallo coros,

vielen dank für deine mühen ;o)
war wohl gestern doch zu spät um mein anliegen genauer zu erklären.

zum kd-nr.-makro
, es kann durchaus mal sein, daß ich in einer anderen zeile anfange, also dazwischen mal leerzeilen entstehen.
habe auch vergessen zu erwähnen das ich schon ein makro habe, dass wenn ich in spalte A etwas eintippe in spalte L das aktuelle datum eingefügt wird.
kann man die zwei irgendwie kombinieren ?
kann es sein, das wenn ich deine zwei makros oben einfüge, sich diese makros beissen ? weil in spalte K keine nummer eingefügt wird.

das wäre das makro:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("$A:$A")) Is Nothing Then
If Target.Value <> "" Then
Target.Offset(0, 11).Value = Date
Else
Target.Offset(0, 11).Value = ""
End If
End If
End Sub

zum druck-makro: funktioniert super, nur kann ich das irgendwie bewerkstelligen, dass
nur die gefüllten zeilen gedruckt werden ? dazu ist noch zusagen, dass ich in spalte B
eine formel drin habe, die ich bis auf zeile 300 runtergezogen habe. die formel hätte
ich aber gerne in den zeilen behalten.

jetzt hoffe ich keine angaben vergessen zu habe, ansonsten bitte fragen.

herzlichen dank und internette grüsse
ponscho

Antwort 3 von coros

Hi mick,

sorry, dass ich mich erst jetzt wieder melde, aber zwischen meinen Antworten hier im Supportnet muss ich auch noch etwas Geldverdienen und dann, kaum zu Hause angekommen, kam dann auch noch ein Rufbereitschaftseinsatz dazwischen. Hier nun also ein neuer Lösungsversuch. Kopiere nachfolgenden Code wieder in das VBA Projekt des Tabellenblattes, in dem Du Deine Daten eingeben willst.

Option Explicit
Public Textlänge As Integer, Text

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Wiederholungen As Long, Zähler As Long, KD_Nummer As Long
Application.EnableEvents = True
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Target.Column = 1 And Target.Row >= 6 And Target.Cells <> "" Then
Cells(Target.Row, 12) = Date
For Wiederholungen = Target.Row To 6 Step -1
If Cells(Wiederholungen, 11) = "" Then
Zähler = Zähler + 1
Else
KD_Nummer = Cells(Wiederholungen, 11)
GoTo Weiter
End If
Next
Weiter:
Cells(Target.Row, 11) = Zähler + KD_Nummer
Application.EnableEvents = True
Exit Sub
End If
If Target.Column = 11 And Textlänge > 0 Then
Textlänge = Len(Target.Cells)
If Target.Column = 11 And Textlänge = 0 Then
Application.EnableEvents = True
Exit Sub
Else
MsgBox "Zum Ändern der KD-Nummer muss die gesamte Nummer gelöscht werden", vbInformation, "Meldung..."
Target.Cells = Text
End If
End If
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Textlänge = Len(Target.Cells)
Text = Target.Cells
End Sub

Der Code macht das gleiche wie der alte, außer, das zum Einen Dein Code mit eingearbeitet wurde und das bei einer Eingabe in Spalte A in Spalte K, die letzte KD-Nummer absteigend von der Zeile der Eingabe ermittelt wird und dann die neue KD-Nummer für die aktuelle Zelle errechnet wird.

Nachfolgendes Makro kopiere wieder in ein StandardModul.

Option Explicit

Sub Drucken()
Dim letzte_Zeile As Long, Wiederholungen As Long
Application.ScreenUpdating = False
letzte_Zeile = Range("A65536").End(xlUp).Row
For Wiederholungen = 6 To letzte_Zeile
If Cells(Wiederholungen, 1) = Empty Then Cells(Wiederholungen, 1).EntireRow.Hidden = True
Next
Columns("A").EntireColumn.Hidden = True
Columns("E:I").EntireColumn.Hidden = True
Columns("K:IV").EntireColumn.Hidden = True
With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$3"
End With
ActiveSheet.PrintOut
With Cells
.EntireRow.Hidden = False
.EntireColumn.Hidden = False
End With
End Sub

Auch dieses Makro besteht noch aus dem alten Teil und es werden nun die Leerzeilen ausgeblendet. Außerdem werden alle Spalte außer B-D und J ausgeblendet, so dass nur die Spalte B-D und J ausgedruckt werden können. Zum Abschluss werden wieder alle ausgeblendeten Zeilen und Spalte eingeblendet.

Teste mal alles und melde Dich wieder bei Problemen oder Fragen.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 4 von ponscho

guten abend oliver,

vielen dank für deine hilfe !
es funktioniert, sind aber noch ein paar kleinigkeiten die nicht so wollen.
wenn du nichts dagegen hast, würde ich dir meine tabelle gerne morgen mal mit ein paar zeilen dazu rübermailen wollen, damit du dir dann mal ein bild drüber machen kannst.

heute will ich dir deinen wohlverdienten feierabend
nicht nehmen ;o)

internette grüsse
ponscho

Antwort 5 von coros

Moin ponscho,

kannst Du gerne machen. E-Mailadresse findest Du auf meiner HP unter andrem im Imprssum.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: