| | | MDG Engineering Nutzt Xometry, Um Medizinische Geräte Zu Bauen Und Das Globale Wachstum Voranzutreiben, ein Anwenderbericht
|
Autor
|
Thema: mehrere textfelder erstellen (1822 mal gelesen)
|
beppe Mitglied
Beiträge: 13 Registriert: 04.03.2015
|
erstellt am: 13. Mrz. 2015 11:30 <-- editieren / zitieren --> Unities abgeben:
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 |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 13. Mrz. 2015 13:09 <-- editieren / zitieren --> Unities abgeben: Nur für beppe
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 |
beppe Mitglied
Beiträge: 13 Registriert: 04.03.2015
|
erstellt am: 15. Mrz. 2015 20:06 <-- editieren / zitieren --> Unities abgeben:
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 |
beppe Mitglied
Beiträge: 13 Registriert: 04.03.2015
|
erstellt am: 16. Mrz. 2015 11:37 <-- editieren / zitieren --> Unities abgeben:
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 |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 16. Mrz. 2015 11:59 <-- editieren / zitieren --> Unities abgeben: Nur für beppe
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 |
MWN Mitglied Dipl.-Ing.
Beiträge: 492 Registriert: 14.02.2007
|
erstellt am: 16. Mrz. 2015 12:09 <-- editieren / zitieren --> Unities abgeben: Nur für beppe
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 |
beppe Mitglied
Beiträge: 13 Registriert: 04.03.2015
|
erstellt am: 16. Mrz. 2015 12:24 <-- editieren / zitieren --> Unities abgeben:
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 |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 16. Mrz. 2015 14:47 <-- editieren / zitieren --> Unities abgeben: Nur für beppe
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 L1End 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 |
beppe Mitglied
Beiträge: 13 Registriert: 04.03.2015
|
erstellt am: 16. Mrz. 2015 16:27 <-- editieren / zitieren --> Unities abgeben:
|
beppe Mitglied
Beiträge: 13 Registriert: 04.03.2015
|
erstellt am: 16. Mrz. 2015 16:55 <-- editieren / zitieren --> Unities abgeben:
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 |
Thomas Harmening Moderator Arbeiter ツ
Beiträge: 2897 Registriert: 06.07.2001 Das Innerste geäussert und aufs Äusserste verinnerlicht
|
erstellt am: 16. Mrz. 2015 17:26 <-- editieren / zitieren --> Unities abgeben: Nur für beppe
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 |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 16. Mrz. 2015 18:08 <-- editieren / zitieren --> Unities abgeben: Nur für beppe
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 |
beppe Mitglied
Beiträge: 13 Registriert: 04.03.2015
|
erstellt am: 16. Mrz. 2015 20:41 <-- editieren / zitieren --> Unities abgeben:
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 |
Thomas Harmening Moderator Arbeiter ツ
Beiträge: 2897 Registriert: 06.07.2001 Das Innerste geäussert und aufs Äusserste verinnerlicht
|
erstellt am: 16. Mrz. 2015 23:07 <-- editieren / zitieren --> Unities abgeben: Nur für beppe
...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 |
MWN Mitglied Dipl.-Ing.
Beiträge: 492 Registriert: 14.02.2007
|
erstellt am: 17. Mrz. 2015 08:16 <-- editieren / zitieren --> Unities abgeben: Nur für beppe
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 |
beppe Mitglied
Beiträge: 13 Registriert: 04.03.2015
|
erstellt am: 17. Mrz. 2015 11:30 <-- editieren / zitieren --> Unities abgeben:
|
beppe Mitglied
Beiträge: 13 Registriert: 04.03.2015
|
erstellt am: 17. Mrz. 2015 13:19 <-- editieren / zitieren --> Unities abgeben:
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 |
Thomas Harmening Moderator Arbeiter ツ
Beiträge: 2897 Registriert: 06.07.2001 Das Innerste geäussert und aufs Äusserste verinnerlicht
|
erstellt am: 17. Mrz. 2015 17:09 <-- editieren / zitieren --> Unities abgeben: Nur für beppe
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 |
beppe Mitglied
Beiträge: 13 Registriert: 04.03.2015
|
erstellt am: 18. Mrz. 2015 10:18 <-- editieren / zitieren --> Unities abgeben:
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 |
Thomas Harmening Moderator Arbeiter ツ
Beiträge: 2897 Registriert: 06.07.2001 Das Innerste geäussert und aufs Äusserste verinnerlicht
|
erstellt am: 18. Mrz. 2015 18:37 <-- editieren / zitieren --> Unities abgeben: Nur für beppe
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 |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 18. Mrz. 2015 21:44 <-- editieren / zitieren --> Unities abgeben: Nur für beppe
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 |
beppe Mitglied
Beiträge: 13 Registriert: 04.03.2015
|
erstellt am: 19. Mrz. 2015 15:19 <-- editieren / zitieren --> Unities abgeben:
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 |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 19. Mrz. 2015 16:13 <-- editieren / zitieren --> Unities abgeben: Nur für beppe
|
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|