Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Excel
  mehrere textfelder erstellen

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:   mehrere textfelder erstellen (1452 mal gelesen)
beppe
Mitglied



Sehen Sie sich das Profil von beppe an!   Senden Sie eine Private Message an beppe  Schreiben Sie einen Gästebucheintrag für beppe

Beiträge: 13
Registriert: 04.03.2015

erstellt am: 13. Mrz. 2015 11:30    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2162
Registriert: 02.05.2006

Office 2010
Visual Basic

erstellt am: 13. Mrz. 2015 13:09    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für beppe 10 Unities + Antwort hilfreich

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



Sehen Sie sich das Profil von beppe an!   Senden Sie eine Private Message an beppe  Schreiben Sie einen Gästebucheintrag für beppe

Beiträge: 13
Registriert: 04.03.2015

erstellt am: 15. Mrz. 2015 20:06    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von beppe an!   Senden Sie eine Private Message an beppe  Schreiben Sie einen Gästebucheintrag für beppe

Beiträge: 13
Registriert: 04.03.2015

erstellt am: 16. Mrz. 2015 11:37    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2162
Registriert: 02.05.2006

Office 2010
Visual Basic

erstellt am: 16. Mrz. 2015 11:59    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für beppe 10 Unities + Antwort hilfreich

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. (BA) Holztechnik & NLP Practitioner


Sehen Sie sich das Profil von MWN an!   Senden Sie eine Private Message an MWN  Schreiben Sie einen Gästebucheintrag für MWN

Beiträge: 479
Registriert: 14.02.2007

SolidWorks Prem. 2013 SP1.0, SolidWorks Prem. 2010 SP5.0, Pascam WoodWorks 2.5, Pascam Bea 1.3, Microsoft Visual Basic 2010 Express & 2013 Express, 3DConnexion SpacePilot Pro, Fujitsu Siemens Celsius M470, Quadro FX1800, Xeon W3550, Win7 32 Bit/64 Bit, 6 GB RAM, 2x HP LP2475w

erstellt am: 16. Mrz. 2015 12:09    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für beppe 10 Unities + Antwort hilfreich

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



Sehen Sie sich das Profil von beppe an!   Senden Sie eine Private Message an beppe  Schreiben Sie einen Gästebucheintrag für beppe

Beiträge: 13
Registriert: 04.03.2015

erstellt am: 16. Mrz. 2015 12:24    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


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

KlaK
Ehrenmitglied V.I.P. h.c.
Dipl. Ing. Vermessung, CAD- und Netz-Admin



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2162
Registriert: 02.05.2006

Office 2010
Visual Basic

erstellt am: 16. Mrz. 2015 14:47    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für beppe 10 Unities + Antwort hilfreich

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

beppe
Mitglied



Sehen Sie sich das Profil von beppe an!   Senden Sie eine Private Message an beppe  Schreiben Sie einen Gästebucheintrag für beppe

Beiträge: 13
Registriert: 04.03.2015

erstellt am: 16. Mrz. 2015 16:27    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

beppe
Mitglied



Sehen Sie sich das Profil von beppe an!   Senden Sie eine Private Message an beppe  Schreiben Sie einen Gästebucheintrag für beppe

Beiträge: 13
Registriert: 04.03.2015

erstellt am: 16. Mrz. 2015 16:55    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


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

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2896
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 16. Mrz. 2015 17:26    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für beppe 10 Unities + Antwort hilfreich

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



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2162
Registriert: 02.05.2006

Office 2010
Visual Basic

erstellt am: 16. Mrz. 2015 18:08    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für beppe 10 Unities + Antwort hilfreich

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



Sehen Sie sich das Profil von beppe an!   Senden Sie eine Private Message an beppe  Schreiben Sie einen Gästebucheintrag für beppe

Beiträge: 13
Registriert: 04.03.2015

erstellt am: 16. Mrz. 2015 20:41    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


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

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2896
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 16. Mrz. 2015 23:07    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für beppe 10 Unities + Antwort hilfreich

...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. (BA) Holztechnik & NLP Practitioner


Sehen Sie sich das Profil von MWN an!   Senden Sie eine Private Message an MWN  Schreiben Sie einen Gästebucheintrag für MWN

Beiträge: 479
Registriert: 14.02.2007

SolidWorks Prem. 2013 SP1.0, SolidWorks Prem. 2010 SP5.0, Pascam WoodWorks 2.5, Pascam Bea 1.3, Microsoft Visual Basic 2010 Express & 2013 Express, 3DConnexion SpacePilot Pro, Fujitsu Siemens Celsius M470, Quadro FX1800, Xeon W3550, Win7 32 Bit/64 Bit, 6 GB RAM, 2x HP LP2475w

erstellt am: 17. Mrz. 2015 08:16    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für beppe 10 Unities + Antwort hilfreich

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



Sehen Sie sich das Profil von beppe an!   Senden Sie eine Private Message an beppe  Schreiben Sie einen Gästebucheintrag für beppe

Beiträge: 13
Registriert: 04.03.2015

erstellt am: 17. Mrz. 2015 11:30    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


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

beppe
Mitglied



Sehen Sie sich das Profil von beppe an!   Senden Sie eine Private Message an beppe  Schreiben Sie einen Gästebucheintrag für beppe

Beiträge: 13
Registriert: 04.03.2015

erstellt am: 17. Mrz. 2015 13:19    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


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

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2896
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 17. Mrz. 2015 17:09    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für beppe 10 Unities + Antwort hilfreich

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



Sehen Sie sich das Profil von beppe an!   Senden Sie eine Private Message an beppe  Schreiben Sie einen Gästebucheintrag für beppe

Beiträge: 13
Registriert: 04.03.2015

erstellt am: 18. Mrz. 2015 10:18    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


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

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2896
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 18. Mrz. 2015 18:37    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für beppe 10 Unities + Antwort hilfreich

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



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2162
Registriert: 02.05.2006

Office 2010
Visual Basic

erstellt am: 18. Mrz. 2015 21:44    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für beppe 10 Unities + Antwort hilfreich

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



Sehen Sie sich das Profil von beppe an!   Senden Sie eine Private Message an beppe  Schreiben Sie einen Gästebucheintrag für beppe

Beiträge: 13
Registriert: 04.03.2015

erstellt am: 19. Mrz. 2015 15:19    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2162
Registriert: 02.05.2006

Office 2010
Visual Basic

erstellt am: 19. Mrz. 2015 16:13    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für beppe 10 Unities + Antwort hilfreich

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2020 CAD.de | Impressum | Datenschutz