---

Sub FarbigerTextFeldImKalenderMitFirmennameErstellen()

Dim FirmenName As String
    FirmenName = Worksheets("auftragserfassung").Cells(4, 2)
    'Position und Größe des Rechtecks setzen
Set rechteck = Worksheets("Kalender").Shapes.AddShape(msoShapeRectangle, 200#, 200#, 80#, 80#)
If Worksheets("Auftragserfassung").Cells(5, 2) = "blau" Then
    'Hintergrundfarbe des Rechtecks festlege
    rechteck.Fill.ForeColor.RGB = RGB(0, 0, 255)
    'Farbe der Linie Festlegen
    rechteck.Line.ForeColor.SchemeColor = 9
    'Dicke der Umrahmung festlegen
    rechteck.Line.Weight = 1.5
    rechteck.name = "meinrechteck"
    rechteck.DrawingObject.Text = FirmenName
End If

Das ist mein code um ein rechteck zu setzten, wenn in der zelle blau steht erzeugt er in eine andere tabelle ein blaues textfeld mit den name der firma.

was ich jetzt machen möchte ist: wenn in einer zelle (9,2 zum beispiel) eine zahl steht soll er genau soviele textfelder in eine andere tabelle erstellen.
kann jemand helfen? mfG, beppe

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo beppe,

So ganz weiß ich zwar nicht was Du vorhast aber mit beiliegenden Code kannst Du das machen

Code:

---

If WorksheetFunction.IsNumber(Tabelle1.Cells(9, 2)) Then
   Zahl = Tabelle1.Cells(9, 2)
   For J = 1 To Zahl
     With Tabelle3
       .Range(.Cells(15 + J, 3), .Cells(15 + J, 3)).Insert xlShiftDown ' xlShiftToRight oder xlShiftDown
       .Cells(15 + J, 3) = "Neuer Wert" & Str(J)
     End With
   Next J
End If

---

Hier werden in Tabelle 3 in der Spalte 3 ("C") ab Zeile 16 neue Zellen eingefügt und die darunterliegend nach unten verschoben.
Wenn Du sicher bist das dort nichts steht kannst Du das Insert natürlich auch weglassen.

Bei der Prüfung auf IsNumber mußt Du ein wenig vorsichtig sein, denn auch ein Datum ist für Excel eine Zahl.

Grüße
Klaus  

[Edit]
Was mir allerdings immer noch nicht klar ist:
Warum erzeugst Du denn ein Grafikelement auf der Kalender-Tabelle?
Und sollen die von Dir erwähnten zusätzlichen Textfelder auch Grafikelemente sein?
Dann müßtest Du natürlich den Code umschreiben und an Stelle des Textschreibens in die Tebellenzelle eine Unterroutine aufrufen. Kannst ja Deinen Code etwas abändern und Position und Inhalt als Variablen übergeben.

[Diese Nachricht wurde von KlaK am 14. Mrz. 2015 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

vielen dank klaus, ich finde es faszinierend wie man immer wieder menschen findet die einem einfach helfen weil sie bock darauf haben!
vielen dank dir, ist erstmal gelöst. wenn was schreibe ich nochmal

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

ich weiß nicht was da erzeugt wird mit deinem code, aber auf jeden fall sind das keine shapes. ich brauche shapes die ich dann im kalender positionieren kann. sodass ich  meine maschinen kapazität im überblick habe

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo beppe,

deshalb habe ich ja das Edit noch hinzugefügt 

Aber um Dir genaueren Code zur Verfügung stellen zu können bräuchte man ein Beispiel wie dieser selbstgebastelte Kalender aussehen soll (am besten eine Beispielarbeitsmappe mit Testcode als zip-Datei hochladen).
Wo sollen die Texte eingefügt werden? Gruppiert oder nicht?
Fragen über Fragen ...

Grüße
Klaus

PS.: Hilfreich ist manchmal auch die Elemente händisch zu erzeugen und dabei das Makro aufzeichnen lassen.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Na dann mach doch einfach:

Code:

---

If WorksheetFunction.IsNumber(Tabelle1.Cells(9, 2)) Then
  Zahl = Tabelle1.Cells(9, 2)
  For J = 1 To Zahl
    Call FarbigerTextFeldImKalenderMitFirmennameErstellen
  Next J
End If

---

Der VBA - Code setzt dann allerdings alle Shapes übereinander (Stapel in Z - Richtung). Vielleicht solltest du in deiner "FarbigerTextFeldImKalenderMitFirmennameErstellen()" noch eine Möglichkeit einbauen, die Shapes in X, oder Y - Richtung mit der Laufvariablen "Zahl" zu verschieben, dass du sie besser per Maus selektieren kannst.

Gruß

Tobias

------------------
Besucht mich doch mal in meiner Tischlerei

"...Kommunikation ist nur so gut wie ihr Ergebnis..." - frei nach Richard Bandler / John Grinder

"...Wenn du das tust, was du schon immer tust, wirst du auch nur das erhalten, was du schon immer erhalten hast..."

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

vbaerstetabelle.png

so hier meine code.

Sub FarbigerTextFeldImKalenderMitFirmennameErstellen()

Dim FirmenName As String
    FirmenName = Worksheets("auftragserfassung").Cells(4, 2)
    'Position und Größe des Rechtecks setzen
Set rechteck = Worksheets("Kalender").Shapes.AddShape(msoShapeRectangle, 200#, 200#, 80#, 80#)
If Worksheets("Auftragserfassung").Cells(5, 2) = "blau" Then
    'Hintergrundfarbe des Rechtecks festlege
    rechteck.Fill.ForeColor.RGB = RGB(0, 0, 255)
    'Farbe der Linie Festlegen
    rechteck.Line.ForeColor.SchemeColor = 9
    'Dicke der Umrahmung festlegen
    rechteck.Line.Weight = 1.5
    rechteck.name = "meinrechteck"
    rechteck.DrawingObject.Text = FirmenName
End If
If Worksheets("Auftragserfassung").Cells(5, 2) = "gelb" Then
    'Hintergrundfarbe des Rechtecks festlege
    rechteck.Fill.ForeColor.RGB = RGB(255, 255, 0)
    'Farbe der Linie Festlegen
    rechteck.Line.ForeColor.SchemeColor = 9
    'Dicke der Umrahmung festlegen
    rechteck.Line.Weight = 1.5
    rechteck.name = "meinrechteck"
    rechteck.DrawingObject.Text = FirmenName
End If
If Worksheets("Auftragserfassung").Cells(5, 2) = "gruen" Then
    'Hintergrundfarbe des Rechtecks festlege
    rechteck.Fill.ForeColor.RGB = RGB(0, 255, 0)
    'Farbe der Linie Festlegen
    rechteck.Line.ForeColor.SchemeColor = 9
    'Dicke der Umrahmung festlegen
    rechteck.Line.Weight = 1.5
    rechteck.name = "meinrechteck"
    rechteck.DrawingObject.Text = FirmenName
End If
If Worksheets("Auftragserfassung").Cells(5, 2) = "rot" Then
    'Hintergrundfarbe des Rechtecks festlege
    rechteck.Fill.ForeColor.RGB = RGB(255, 0, 0)
    'Farbe der Linie Festlegen
    rechteck.Line.ForeColor.SchemeColor = 9
    'Dicke der Umrahmung festlegen
    rechteck.Line.Weight = 1.5
    rechteck.name = "meinrechteck"
    rechteck.DrawingObject.Text = FirmenName
End If
If Worksheets("Auftragserfassung").Cells(5, 2) = "pink" Then
    'Hintergrundfarbe des Rechtecks festlege
    rechteck.Fill.ForeColor.RGB = RGB(255, 192, 203)
    'Farbe der Linie Festlegen
    rechteck.Line.ForeColor.SchemeColor = 9
    'Dicke der Umrahmung festlegen
    rechteck.Line.Weight = 1.5
    rechteck.name = "meinrechteck"
    rechteck.DrawingObject.Text = FirmenName
End If
If Worksheets("Auftragserfassung").Cells(5, 2) = "schwarz" Then
    'Hintergrundfarbe des Rechtecks festlege
    rechteck.Fill.ForeColor.RGB = RGB(0, 0, 0)
    'Farbe der Linie Festlegen
    rechteck.Line.ForeColor.SchemeColor = 9
    'Dicke der Umrahmung festlegen
    rechteck.Line.Weight = 1.5
    rechteck.name = "meinrechteck"
    rechteck.DrawingObject.Text = FirmenName
End If
If Worksheets("Auftragserfassung").Cells(5, 2) = "grau" Then
    'Hintergrundfarbe des Rechtecks festlege
    rechteck.Fill.ForeColor.RGB = RGB(190, 190, 190)
    'Farbe der Linie Festlegen
    rechteck.Line.ForeColor.SchemeColor = 9
    'Dicke der Umrahmung festlegen
    rechteck.Line.Weight = 1.5
    rechteck.name = "meinrechteck"
    rechteck.DrawingObject.Text = FirmenName
End If
If Worksheets("Auftragserfassung").Cells(5, 2) = "lila" Then
    'Hintergrundfarbe des Rechtecks festlege
    rechteck.Fill.ForeColor.RGB = RGB(238, 130, 238)
    'Farbe der Linie Festlegen
    rechteck.Line.ForeColor.SchemeColor = 9
    'Dicke der Umrahmung festlegen
    rechteck.Line.Weight = 1.5
    rechteck.name = "meinrechteck"
    rechteck.DrawingObject.Text = FirmenName
End If
If Worksheets("Auftragserfassung").Cells(5, 2) = "ral" Then
    'Hintergrundfarbe des Rechtecks festlege
    rechteck.Fill.ForeColor.RGB = RGB(255, 140, 0)
    'Farbe der Linie Festlegen
    rechteck.Line.ForeColor.SchemeColor = 9
    'Dicke der Umrahmung festlegen
    rechteck.Line.Weight = 1.5
    rechteck.name = "meinrechteck"
    rechteck.DrawingObject.Text = FirmenName
End If
End Sub

ich möchte das wenn in zelle 9,2 zum beispiel 10 steht mir auf die zweite tabelle (kalender), 10 textfelder erstellt werden. im moment erzeugt er 1 wenn blau da steht.
wenn 10 textfelder erzeugt werden kann ich sie dann im kalender so positionieren das ich weiß wann die maschine wieder frei sein wird.
oh man bin so schlecht! hoffe man versteht was ich mein

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

Aller Anfang ist schwer aber je mehr man sich damit beschäftigt umso leichter fällt eine Lösung     
Du solltest Dir angewöhnen Text sinnvoll zusammen, das erhöht die Übersichtlichkeit und spart tippen / kopieren.
Beiliegend mal eine Variante wie das gehen könnte.

Über die Schleife L1 werden die nachfolgenden Arbeitsschritte auch gleich erzeugt

Code:

---

Sub Make_Eintraege()
    Dim exS As Long
    Dim exR As Long
    Dim KalOx As Double, KalOy As Double
    Dim KalBreit As Double, KalHoch As Double
    Dim FirmenName As String
    Dim Arbeit As String
    Dim L1 As Long, L2 As Long
    Dim Zahl As Long
   
    exS = 2
    exR = 9
    KalOx = 200#: KalOy = 200#
    KalBreit = 80#: KalHoch = 80#
    FirmenName = Worksheets("auftragserfassung").Cells(4, exS)
    Select Case Worksheets("Auftragserfassung").Cells(5, exS)
      'Hintergrundfarbe des Rechtecks festlege
      Case "blau":    Farbe = RGB(0, 0, 255)
      Case "gelb":    Farbe = RGB(255, 255, 0)
      Case "gruen":   Farbe = RGB(0, 255, 0)
      Case "rot":     Farbe = RGB(255, 0, 0)
      Case "pink":    Farbe = RGB(255, 192, 203)
      Case "schwarz": Farbe = RGB(0, 0, 0)
      Case "grau":    Farbe = RGB(190, 190, 190)
      Case "lila":    Farbe = RGB(238, 130, 238)
      Case "ral":     Farbe = RGB(255, 140, 0)
    End Select
    For L1 = 9 To 13
      If WorksheetFunction.IsNumber(Tabelle1.Cells(L1, exS)) Then
        Zahl = Tabelle1.Cells(L1, exS)
        For L2 = 1 To Zahl
          Arbeit = Worksheets("auftragserfassung").Cells(L1, 1) & " " & Str(L2)
          ' Call FarbigerTextFeldImKalenderMitFirmennameErstellen(FirmenName, Arbeit, KalOx, KalOy, KalBreit, KalHoch, Farbe)
          ' KalOy = KalOy + KalHoch ' oder z.B. KalHoch / 10 wenn die Felder näher zusammen liegen sollen
          ' besser :
          Call FarbigerTextFeldImKalenderMitFirmennameErstellen(FirmenName, Arbeit, _
             KalOx + KalBreit * (L2 - 1), KalOy + KalHoch * (L1 - 1), KalBreit, KalHoch, Farbe)
        Next L2
      End If
    Next L1

End Sub

Sub FarbigerTextFeldImKalenderMitFirmennameErstellen(FirmenName As String, ArbS As String, _
    X As Double, Y As Double, B As Double, H As Double, Farbe As Variant)

    ' Dim FirmenName As String
   
    ' FirmenName = Worksheets("auftragserfassung").Cells(4, 2)
   
    ' Position und Größe des Rechtecks setzen
    ' Set rechteck = Worksheets("Kalender").Shapes.AddShape(msoShapeRectangle, 200#, 200#, 80#, 80#)
    Set rechteck = Worksheets("Kalender").Shapes.AddShape(msoShapeRectangle, X, Y, B, H)
    With rechteck
      'Farbe der Linie Festlegen
      .Line.ForeColor.SchemeColor = 9
      'Dicke der Umrahmung festlegen
      .Line.Weight = 1.5
      .Name = "meinrechteck"
      .TextFrame2.TextRange.Characters.Text = FirmenName & vbCrLf & ArbS
      .TextFrame2.TextRange.Characters.ParagraphFormat.Alignment = msoAlignCenter ' msoAlignLeft
      '.DrawingObject.Text = FirmenName
      .Fill.ForeColor.RGB = Farbe
    End With
End Sub

---

Habe mir erlaubt Firmenname und Arbeitsschritt zusammen zu fassen     
Wie Du siehst ist es leichter mit Variablen zu arbeiten.
Wenn Du jetzt in den Spalten D,E,F noch Werte hast brauchst Du nur die Variable exS zu erhöhen.

Grüße
Klaus     

[edit] Noch schnell das Schreiben geändert, ist übersichtlicher ...

[Diese Nachricht wurde von KlaK am 16. Mrz. 2015 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

klaus vielen dank du kannst ja was !!!
hast mir sogar die anderen arbeitsschritte dazugetan, und das aller beste es funktioniert sogar. big hug erstmal. ich melde mich bestimmt wieder

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

screenVBAHIlfe.png

habe jetzt was dazu gedichtet, screenshot leg ich bei.
schaffst du es dass in den textfeld auch das eingangs und  lieferungsdatum drin steht?
jetzt hab ich neben den arbeitsprozeduren noch eine zeit angegeben. kann die größe der textfelder anhand dieser zeit angepasst werden?

und wichtiger, dass ist jetzt alles perfekt wenn eine bestellung mit nur eine gewünschte farbe eingeht. was aber wenn der kunde 3 farben haben möchte? (im screenshot kannst du sehen was ich meine)

danke im vorraus, wenn kein bock hast verstehe ich das. wenn ich dich auf ein bier einladen kann, ich befinde mich entweder in münchen oder im schwarzwald!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hint:

Sub Make_Eintraege()
...
FirmenName = Worksheets("auftragserfassung").Cells(4, exS)
...
End Sub

noch um 2 weitere Variablen eingangs und  lieferungsdatum Erweitern

Sub FarbigerTextFeldImKalenderMitFirmennameErstellen(FirmenName As String, ArbS As String, _
    X As Double, Y As Double, B As Double, H As Double, Farbe As Variant)

um eingangs As String
lieferungsdatum  As String
Erweitern

.TextFrame2.TextRange.Characters.Text = FirmenName & vbCrLf & ArbS

um eingangs und lieferungsdatum erweitern

End Sub

ggf überdenken ob es wirklich einzelshapes sein müssen oder die Breite des Shapes = Minutendauer entsprechen

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von beppe:
habe jetzt was dazu gedichtet, screenshot leg ich bei.
schaffst du es dass in den textfeld auch das eingangs und  lieferungsdatum drin steht?

---

Hat Thomas schon ergänzt

Zitat:

---

jetzt hab ich neben den arbeitsprozeduren noch eine zeit angegeben. kann die größe der textfelder anhand dieser zeit angepasst werden?

---

Dir fallen auch immer wieder neue Spielereien ein...
Im Prinzip muß man dazu ja nur die Variable KalBreit auf den entsprechenden Wert setzen. Thomas Anregung solltest Du Dir aber auch überlegen, denn dann brauchst Du nur ein Shape verschieben. Außer ihr braucht zwischendurch die Pausen z.B. beim färben. Evtl. muß man im Programm noch berücksichtigen dass die automatische Anpassung ausgeschalten ist und dass der Text auch über den Rand geschrieben werden kann. Wie breit sind Einheiten (z.B. 10 min)?

Zitat:

---

und wichtiger, dass ist jetzt alles perfekt wenn eine bestellung mit nur eine gewünschte farbe eingeht. was aber wenn der kunde 3 farben haben möchte? (im screenshot kannst du sehen was ich meine)

---

Hatte ich Dir ja schon angedeutet. Laufvariable über die benötigten Spalten und Abfrage mit
do While not IsEmpty(cells(exR,exS))
loop

Zitat:

---

danke im vorraus, wenn kein bock hast verstehe ich das. wenn ich dich auf ein bier einladen kann, ich befinde mich entweder in münchen oder im schwarzwald!

---

Da sind wir ja gar nicht so weit weg voneinander 

Grüße
Klaus

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

tabelle1vba.png kalendervba.png

also erstmal danke an beide. zu Thomas, ja es müssen einzelshapes sein, jedes davon ist ein durchgang der maschine, die stell ich dann ein wenig versetzt in den kalender ein. (so dass man zeit hat um die maschine zu leeren und wieder füllen z.B.)

sind wieder 2 screens dabei, einer vom kalender (tabelle2), einer von auftragserfassung (tabelle1)

zitat Klaus:
Evtl. muß man im Programm noch berücksichtigen dass die automatische Anpassung ausgeschalten ist und dass der Text auch über den Rand geschrieben werden kann. Wie breit sind Einheiten (z.B. 10 min)?

ganz genau, und ja eine zeile im kalender hat 10 minuten. Das mit der zeit anpassung kann ich theoretisch auch manuell machen, aber cool wärs schon.
Das was du mir gegeben hast funktioniert und ich will da nicht rum fuchteln. wenn einer von euch es vielleicht zu einem ganzen verfassen könnte, wäre das traumhaft.
das ist was ich habe: (dank Klaus)

Sub Make_Eintraege()
    Dim exS As Long
    Dim exR As Long
    Dim KalOx As Double, KalOy As Double
    Dim KalBreit As Double, KalHoch As Double
    Dim FirmenName As String
    Dim Arbeit As String
    Dim L1 As Long, L2 As Long
    Dim Zahl As Long
   
    exS = 2
    exR = 9
    KalOx = 200#: KalOy = 200#
    KalBreit = 80#: KalHoch = 80#
    FirmenName = Worksheets("auftragserfassung").Cells(4, exS)
    Select Case Worksheets("Auftragserfassung").Cells(5, exS)
      'Hintergrundfarbe des Rechtecks festlege
      Case "blau":    Farbe = RGB(0, 0, 255)
      Case "gelb":    Farbe = RGB(255, 255, 0)
      Case "gruen":  Farbe = RGB(0, 255, 0)
      Case "rot":    Farbe = RGB(255, 0, 0)
      Case "pink":    Farbe = RGB(255, 192, 203)
      Case "schwarz": Farbe = RGB(0, 0, 0)
      Case "grau":    Farbe = RGB(190, 190, 190)
      Case "lila":    Farbe = RGB(238, 130, 238)
      Case "ral":    Farbe = RGB(255, 140, 0)
    End Select
    For L1 = 9 To 13
      If WorksheetFunction.IsNumber(Tabelle1.Cells(L1, exS)) Then
        Zahl = Tabelle1.Cells(L1, exS)
        For L2 = 1 To Zahl
          Arbeit = Worksheets("auftragserfassung").Cells(L1, 1) & " " & Str(L2)
          ' Call FarbigerTextFeldImKalenderMitFirmennameErstellen(FirmenName, Arbeit, KalOx, KalOy, KalBreit, KalHoch, Farbe)
          ' KalOy = KalOy + KalHoch ' oder z.B. KalHoch / 10 wenn die Felder näher zusammen liegen sollen
          ' besser :
          Call FarbigerTextFeldImKalenderMitFirmennameErstellen(FirmenName, Arbeit, _
            KalOx + KalBreit * (L2 - 1), KalOy + KalHoch * (L1 - 1), KalBreit, KalHoch, Farbe)
        Next L2
      End If
    Next L1
End Sub

Sub FarbigerTextFeldImKalenderMitFirmennameErstellen(FirmenName As String, ArbS As String, _
    X As Double, Y As Double, B As Double, H As Double, Farbe As Variant)

    ' Dim FirmenName As String
   
    ' FirmenName = Worksheets("auftragserfassung").Cells(4, 2)
   
    ' Position und Größe des Rechtecks setzen
    ' Set rechteck = Worksheets("Kalender").Shapes.AddShape(msoShapeRectangle, 200#, 200#, 80#, 80#)
    Set rechteck = Worksheets("Kalender").Shapes.AddShape(msoShapeRectangle, X, Y, B, H)
    With rechteck
      'Farbe der Linie Festlegen
      .Line.ForeColor.SchemeColor = 9
      'Dicke der Umrahmung festlegen
      .Line.Weight = 1.5
      .name = "meinrechteck"
      .TextFrame2.TextRange.Characters.Text = FirmenName & vbCrLf & ArbS
      .TextFrame2.TextRange.Characters.ParagraphFormat.Alignment = msoAlignCenter ' msoAlignLeft
      '.DrawingObject.Text = FirmenName
      .Fill.ForeColor.RGB = Farbe
    End With
End Sub

Ja und dass mit dem Bier steht jederzeit, musst halt koordinaten angeben! 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

...naja, wir können es,
aber Sinn und Zweck wäre es eigentlich das du es kannst. F8 und schrittweise den Code ablaufen lassen.

BTW Dieses hinterherprogrammiere (neue Wünsche/Ideen) wäre nix für mich. Bier hin oder her   
Klare Vorgaben, klare Bsp-mappe und der Helfende tut sich leichter (hier zb. Zeit als Shape grösse, die meisten hätten wohl die Breite gewählt;-)

Die Rüstzeit kann man ja auch in die Shapehöhe mit einfliesen lassen, sofern nicht gravierende Unterschiede in den Rüstzeiten vorhanden ist.

Daraus ergibt sich die Shapes gleich zu transponieren von oben nach unten, sofern das sinnvoll ist und ggf. dem Anwender die Zielzelle auswählen zu lassen (Schleife je Gewerk), so das nur noch die über die Maschinenlaufzeit gehenden Shapes händisch umgesetzt werden müssen - dies nur als Idee   

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Guten Morgen,

OFFTOPIC

btw: wenn es ein Bier, nach genau deinen Vorstellungen sein soll, dann probier doch mal www.bierzuliebe.de. Dann kannst du es auch "Excel - Thread - Dankeschön - Bier" nennen... 

Bitte nicht schlagen, nein, ich bin daran nicht beteiligt, habe auch nix davon und ja, es ist nur ein Vorschlag, da ich es selber neulich als Geschenk probiert habe und recht begeistert davon bin!

OFFTOPIC ENDE

Beste Grüße

Tobias

------------------
Besucht mich doch mal in meiner Tischlerei

"...Kommunikation ist nur so gut wie ihr Ergebnis..." - frei nach Richard Bandler / John Grinder

"...Wenn du das tust, was du schon immer tust, wirst du auch nur das erhalten, was du schon immer erhalten hast..."

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

fehlerBeimKompi.png

das mit den eingangs und lieferungs datum ist schonmal geschafft

[Diese Nachricht wurde von beppe am 17. Mrz. 2015 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

tabelle1vba.png

Zitat von mir:
und wichtiger, dass ist jetzt alles perfekt wenn eine bestellung mit nur eine gewünschte farbe eingeht. was aber wenn der kunde 3 farben haben möchte? (im screenshot kannst du sehen was ich meine)

Antwort vom Klaus:
Hatte ich Dir ja schon angedeutet. Laufvariable über die benötigten Spalten und Abfrage mit
do While not IsEmpty(cells(exR,exS))
loop
Wenn Du jetzt in den Spalten D,E,F noch Werte hast brauchst Du nur die Variable exS zu erhöhen.

das bekomm ich nicht hin...

das ganze sieht jetzt so aus:

Sub Make_Eintraege()
    Dim exS As Long
    Dim exR As Long
    Dim KalOx As Double, KalOy As Double
    Dim KalBreit As Double, KalHoch As Double
    Dim FirmenName As String
    Dim Arbeit As String
    Dim L1 As Long, L2 As Long
    Dim Zahl As Long
    Dim eingangs As String
    Dim lieferungsdatum As String
   
    exS = 2
    exR = 9
    KalOx = 700#: KalOy = 10#
    KalBreit = 80#: KalHoch = 80#
    FirmenName = Worksheets("auftragserfassung").Cells(4, exS)
    Select Case Worksheets("Auftragserfassung").Cells(5, exS)
      'Hintergrundfarbe des Rechtecks festlege
      Case "blau":    Farbe = RGB(0, 0, 255)
      Case "gelb":    Farbe = RGB(255, 255, 0)
      Case "gruen":  Farbe = RGB(0, 255, 0)
      Case "rot":    Farbe = RGB(255, 0, 0)
      Case "pink":    Farbe = RGB(255, 192, 203)
      Case "schwarz": Farbe = RGB(0, 0, 0)
      Case "grau":    Farbe = RGB(190, 190, 190)
      Case "lila":    Farbe = RGB(238, 130, 238)
      Case "ral":    Farbe = RGB(255, 140, 0)
    End Select
    For L1 = 9 To 13
      If WorksheetFunction.IsNumber(Tabelle1.Cells(L1, exS)) Then
        Zahl = Tabelle1.Cells(L1, exS)
        For L2 = 1 To Zahl
          Arbeit = Worksheets("auftragserfassung").Cells(L1, 1) & " " & Str(L2)
          eingangs = Worksheets("auftragserfassung").Cells(3, exS)
            lieferungsdatum = Worksheets("auftragserfassung").Cells(15, exS)
          ' Call FarbigerTextFeldImKalenderMitFirmennameErstellen(FirmenName, Arbeit, KalOx, KalOy, KalBreit, KalHoch, Farbe)
          ' KalOy = KalOy + KalHoch ' oder z.B. KalHoch / 10 wenn die Felder näher zusammen liegen sollen
          ' besser :
        Call FarbigerTextFeldImKalenderMitFirmennameErstellen(FirmenName, Arbeit, _
            KalOx + KalBreit * (L2 - 1), KalOy + KalHoch * (L1 - 1), KalBreit, KalHoch, Farbe, eingangs, lieferungsdatum)
        Next L2
      End If
    Next L1
End Sub

Sub FarbigerTextFeldImKalenderMitFirmennameErstellen(FirmenName As String, ArbS As String, _
    X As Double, Y As Double, B As Double, H As Double, Farbe As Variant, eingangs As String, lieferungsdatum As String)

    ' Dim FirmenName As String
   
    ' FirmenName = Worksheets("auftragserfassung").Cells(4, 2)
   
    ' Position und Größe des Rechtecks setzen
    ' Set rechteck = Worksheets("Kalender").Shapes.AddShape(msoShapeRectangle, 200#, 200#, 80#, 80#)
    Set rechteck = Worksheets("Kalender").Shapes.AddShape(msoShapeRectangle, X, Y, B, H)
    With rechteck
      'Farbe der Linie Festlegen
      .Line.ForeColor.SchemeColor = 9
      'Dicke der Umrahmung festlegen
      .Line.Weight = 1.5
      .name = "meinrechteck"
      .TextFrame2.TextRange.Characters.Text = eingangs & vbCrLf & FirmenName & vbCrLf & ArbS & vbCrLf & lieferungsdatum
      .TextFrame2.TextRange.Characters.ParagraphFormat.Alignment = msoAlignCenter ' msoAlignLeft
      '.DrawingObject.Text = FirmenName
      .Fill.ForeColor.RGB = Farbe
    End With
End Sub

[Diese Nachricht wurde von beppe am 17. Mrz. 2015 editiert.]

[Diese Nachricht wurde von beppe am 17. Mrz. 2015 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Hatte ich Dir ja schon angedeutet. Laufvariable über die benötigten Spalten und Abfrage mit
do While not IsEmpty(cells(exR,exS))
loop
Wenn Du jetzt in den Spalten D,E,F noch Werte hast brauchst Du nur die Variable exS zu erhöhen.

---

exS = 2 'hint 2 = B 6= F 10 = J = Step 4
exR = 9

um

Code:

---

For L1 = 9 To 13
...
Next L1

---

muss noch eine weitere Schleife rum aka

Code:

---

For exS = 2 to 10 step 4
...
Next exS

---

offtopicon
ich mal 10 Flaschen von http://www.gize.com/de/ ^^
Offtopicoff

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

auftragErf.png

Danke Thomas, wieder einen schritt weiter!! Habe es folgendermaßen eingebaut.
er stellt jetzt zwar soviele textfelder her wie in den spalten B-F-J(9 bis 13) durch eine zahl angegeben sind, aber:

- das programm nimmt die farbe aus der bestellung in spalte B5 statt für jede spalte die angegebene zu wählen.

ciaociao, beppe

Code:

---

Sub Make_Eintraege()
    Dim exS As Long
    Dim exR As Long
    Dim KalOx As Double, KalOy As Double
    Dim KalBreit As Double, KalHoch As Double
    Dim FirmenName As String
    Dim Arbeit As String
    Dim L1 As Long, L2 As Long
    Dim Zahl As Long
    Dim eingangs As String
    Dim lieferungsdatum As String
   
    exS = 2
    exR = 9
    KalOx = 700#: KalOy = 10#
    KalBreit = 80#: KalHoch = 80#
    FirmenName = Worksheets("auftragserfassung").Cells(4, exS)

    Select Case Worksheets("Auftragserfassung").Cells(5, exS)
      'Hintergrundfarbe des Rechtecks festlege
      Case "blau":    Farbe = RGB(0, 0, 255)
      Case "gelb":    Farbe = RGB(255, 255, 0)
      Case "gruen":   Farbe = RGB(0, 255, 0)
      Case "rot":     Farbe = RGB(255, 0, 0)
      Case "pink":    Farbe = RGB(255, 192, 203)
      Case "schwarz": Farbe = RGB(0, 0, 0)
      Case "grau":    Farbe = RGB(190, 190, 190)
      Case "lila":    Farbe = RGB(238, 130, 238)
      Case "ral":     Farbe = RGB(255, 140, 0)
    End Select

    For L1 = 9 To 13
    For exS = 2 To 10 Step 4
      If WorksheetFunction.IsNumber(Tabelle1.Cells(L1, exS)) Then
        Zahl = Tabelle1.Cells(L1, exS)
        For L2 = 1 To Zahl
          Arbeit = Worksheets("auftragserfassung").Cells(L1, 1) & " " & Str(L2)
           eingangs = Worksheets("auftragserfassung").Cells(3, exS)
            lieferungsdatum = Worksheets("auftragserfassung").Cells(15, exS)
          ' Call FarbigerTextFeldImKalenderMitFirmennameErstellen(FirmenName, Arbeit, KalOx, KalOy, KalBreit, KalHoch, Farbe)
          ' KalOy = KalOy + KalHoch ' oder z.B. KalHoch / 10 wenn die Felder näher zusammen liegen sollen
          ' besser :
        Call FarbigerTextFeldImKalenderMitFirmennameErstellen(FirmenName, Arbeit, _
             KalOx + KalBreit * (L2 - 1), KalOy + KalHoch * (L1 - 1), KalBreit, KalHoch, Farbe, eingangs, lieferungsdatum)
        Next L2
      End If
      Next exS
    Next L1

End Sub

Sub FarbigerTextFeldImKalenderMitFirmennameErstellen(FirmenName As String, ArbS As String, _
    X As Double, Y As Double, B As Double, H As Double, Farbe As Variant, eingangs As String, lieferungsdatum As String)

    ' Dim FirmenName As String
   
    ' FirmenName = Worksheets("auftragserfassung").Cells(4, 2)
   
    ' Position und Größe des Rechtecks setzen
    ' Set rechteck = Worksheets("Kalender").Shapes.AddShape(msoShapeRectangle, 200#, 200#, 80#, 80#)
    Set rechteck = Worksheets("Kalender").Shapes.AddShape(msoShapeRectangle, X, Y, B, H)
    With rechteck
      'Farbe der Linie Festlegen
      .Line.ForeColor.SchemeColor = 9
      'Dicke der Umrahmung festlegen
      .Line.Weight = 1.5
      .name = "meinrechteck"
      .TextFrame2.TextRange.Characters.Text = eingangs & vbCrLf & FirmenName & vbCrLf & ArbS & vbCrLf & lieferungsdatum
      .TextFrame2.TextRange.Characters.ParagraphFormat.Alignment = msoAlignCenter ' msoAlignLeft
      '.DrawingObject.Text = FirmenName
      .Fill.ForeColor.RGB = Farbe
    End With
End Sub

---

[Diese Nachricht wurde von beppe am 18. Mrz. 2015 editiert.]

[Diese Nachricht wurde von beppe am 18. Mrz. 2015 editiert.]

THEDIT: ich habe mal formatiert  

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ok, das mit der Schleife hat ja hingehauen,

zum "warum übernimmt er nicht die Farbe" - ich habe mal deinen Beitrag ein wenig formatiert
Code - nur der besseren Lesbarkeit
kursiv - dort wird die Zelle ausgelesen das die Farbe definiert... und per case (entspricht) definiere Farbe = RGB(x , x, x)
Fett - deine Schleife die die 3 Spalten abarbeitet

was fällt dir auf? die steht ganz alleine da draussen - oder?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Is ja fies  der kann einfach in fremden Code basteln ...
Will auch Mod-Rechte 

(nicht wirklich)

THEDIT: Mod ist nichts besonderes  wenn man eh -aus welchen interessen auch immer - hier aktiv ist - und mehr Arbeit macht es auch nicht
- wenn ein Diskussion entgleist, sollte man eingreifen (was hier so gut wie nie passiert)
- man ist auch als Mod nicht gezwungen immer und überall zu helfen
- wenn man einen fremden Beitrag editiert, sollte man dies kenntlich machen.
- dein (nicht wirklich) erscheint mir wie ein >Schaden tut's wohl nicht< ;-)

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

so jungs. vielen dank mein (unser) programm läuft                   

echt cool von euch! KLaus ich schreib dir wieder ne e-mail wenn ich zeit habe um was trinken zu gehen; etwa 2 wochen.
liebe Grüße Beppone

[Diese Nachricht wurde von beppe am 19. Mrz. 2015 editiert.]

[Diese Nachricht wurde von beppe am 19. Mrz. 2015 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Na dann,
Setze ich einmal das erledigt Häkchen 

@Thomas: Nicht wirklich weil: Bin schon Admin in einem anderem Forum ...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP