Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

VB Editor





Frage

Hallo Forum, öffne mit einem Makro eine neue Excel Datei. Ist es möglich über das Makro einen Code in den VB Editor des neuen Sheets zu schreiben? Für eure Hilfe wäre ich euch sehr dankbar! vg Thomas

Antwort 1 von coros

Hi Thomas,

um da etwas genaueres dazu zu sagen, benötigt man schon ein paar mehr Infos. Man kann schon in eine andere Exceldatei z.B. ein VBA Code erstellen. Aber man benötigt, wie schon gesagt ein paar mehr Angabe von Dir, was Du erreichen möchtest. Nachfolgend mal ein VBA Beispielcode, der eine neue Datei erstellt und dort in das VBA Projekt "DieseArbeitsmappe" den Code

Private Sub Workbook_Open()
MsgBox "Hallo"
End Sub


einträgt. Der Code, der das macht sieht folgendermaßen aus und gehört in ein StandardModul und muss dann durch eine Befehlsschaltfläche gestartet werden.

Sub VBA_Code_erstellen()
Workbooks.Add
With Application.VBE.ActiveVBProject.VBComponents("DieseArbeitsmappe").CodeModule
    .InsertLines 3, "Private Sub Workbook_Open()"
    .InsertLines 4, "MsgBox ""Hallo"" "
    .InsertLines 6, "End Sub"
End With
End Sub



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

Antwort 2 von Thomas81

Hallo coros,

herzlichen Dank für Deine hilfe, ist genau das was ich gesucht habe.
Hätte nur noch eine Frage wenn ich den Code ActiveSheet.ChartObjects("Chart 1").Activate
übertragen möchte bekomme ich die Fehlermeldung expected end of statement
und bei If Target.Cells = "" Then werden die Anführungszeichen weg gelassen. Weißt Du was ich da anders machen muss?

noch einmal danke für Deine Hilfe!
Thomas

Antwort 3 von coros

Hi Thomas,

irgendwie schreibst Du wirr. Du schreibst, Du möchtest die Anweisung

ActiveSheet.ChartObjects("Chart 1").Activate


übertragen. Dann schreibst Du aber, dass Du eine Fehlermeldung erhälst und das Dir bei der Anweisung

If Target.Cells = ""

die Anführungsstriche weggelassen werden. Die eine Anweisung hat mit der anderen überhaupt nichts zu tun, daher verstehe ich Deine Frage auch nicht. Schreibe hier doch einfach mal hin, welcher Code übertragen werden soll.

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

Antwort 4 von Thomas81

Hallo coros,
tut mir leid wenn es unverständlich war. Der Code ist zum definieren von Grenzwerten für ein Balkendiagramm.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varArray As Variant, objSeries As Series, intIndex As Integer

Application.ScreenUpdating = False
If Target.Cells.Count > 1 Then Exit Sub
Sheets("Sheet2").Select
ActiveSheet.ChartObjects("Chart 2").Activate ´Name anpassen!!
Set objSeries = ActiveChart.SeriesCollection(1)
varArray = objSeries.Values
For intIndex = LBound(varArray) To UBound(varArray)
With objSeries.Points(intIndex)
If varArray(intIndex) = 1 Then .Interior.ColorIndex = 3
If varArray(intIndex) = 1 Then .Interior.ColorIndex = 3
If varArray(intIndex) = 2 Then .Interior.ColorIndex = 4
If varArray(intIndex) = 2 Then .Interior.ColorIndex = 4
If varArray(intIndex) = 3 Then .Interior.ColorIndex = 5
If varArray(intIndex) = 3 Then .Interior.ColorIndex = 5
If varArray(intIndex) = 4 Then .Interior.ColorIndex = 6
If varArray(intIndex) = 4 Then .Interior.ColorIndex = 6
If varArray(intIndex) = 5 Then .Interior.ColorIndex = 7
If varArray(intIndex) = 5 Then .Interior.ColorIndex = 7
If varArray(intIndex) = 6 Then .Interior.ColorIndex = 8
If varArray(intIndex) = 6 Then .Interior.ColorIndex = 8
End With
Sheets("Sheet1").Select
Next
Target.Activate
Application.ScreenUpdating = True
End Sub


gruss
Thomas

Antwort 5 von coros

Hallo Thomas,

nachfolgend der Code, der beim Ausführen eine neue Datei anlegt und in das VBA Projekt von Tabelle1 den von Dir geposteten Code erstellt. Kopiere ihn wieder in ein StandardModul und starte ihn mit einer Schaltfläche.


Sub VBA_Code_erstellen()
Workbooks.Add
With Application.VBE.ActiveVBProject.VBComponents("Tabelle1").CodeModule
.InsertLines 3, "Private Sub Worksheet_Change(ByVal Target As Range)"
.InsertLines 4, "Dim varArray As Variant, objSeries As Series, intIndex As Integer"
.InsertLines 5, "Application.ScreenUpdating = False"
.InsertLines 6, "If Target.Cells.Count > 1 Then Exit Sub"
.InsertLines 7, "Sheets(""Sheet2"").Select"
.InsertLines 8, "ActiveSheet.ChartObjects(""Chart 2"").Activate"
.InsertLines 9, "Set objSeries = ActiveChart.SeriesCollection(1)"
.InsertLines 10, "varArray = objSeries.Values"
.InsertLines 11, "For intIndex = LBound(varArray) To UBound(varArray)"
.InsertLines 12, "With objSeries.Points(intIndex)"
.InsertLines 13, "If varArray(intIndex) = 1 Then .Interior.ColorIndex = 3"
.InsertLines 14, "If varArray(intIndex) = 1 Then .Interior.ColorIndex = 3"
.InsertLines 15, "If varArray(intIndex) = 2 Then .Interior.ColorIndex = 4"
.InsertLines 16, "If varArray(intIndex) = 2 Then .Interior.ColorIndex = 4"
.InsertLines 17, "If varArray(intIndex) = 3 Then .Interior.ColorIndex = 5"
.InsertLines 18, "If varArray(intIndex) = 3 Then .Interior.ColorIndex = 5"
.InsertLines 19, "If varArray(intIndex) = 4 Then .Interior.ColorIndex = 6"
.InsertLines 20, "If varArray(intIndex) = 4 Then .Interior.ColorIndex = 6"
.InsertLines 21, "If varArray(intIndex) = 5 Then .Interior.ColorIndex = 7"
.InsertLines 22, "If varArray(intIndex) = 5 Then .Interior.ColorIndex = 7"
.InsertLines 23, "If varArray(intIndex) = 6 Then .Interior.ColorIndex = 8"
.InsertLines 24, "If varArray(intIndex) = 6 Then .Interior.ColorIndex = 8"
.InsertLines 25, "End With"
.InsertLines 26, "Sheets(""Sheet1"").Select"
.InsertLines 27, "Next"
.InsertLines 28, "Target.Activate"
.InsertLines 29, "Application.ScreenUpdating = True"
.InsertLines 30, "End Sub"
End With
End Sub



Noch mal eine kleine Frage, Du bist nicht zufällig der Philip, der mich angemailt hat wegen der Beispieldatei zur Farbänderung von Diagrammbalken und dem ich gestern komischerweise genau den gleichen Code gemailt habe. Ich komme nur darauf, weil Du in der Antwort 2 von der Anweisung If Target.Cells = "" schreibst, die aber gar nicht mehr in Deinem Posting vorkommt. Dort kommt nun If Target.Cells.Count > 1 Then Exit Sub vor. Bei dem Philip kam es in der Anweisung If Target.Cells = "" zu einem Fehler, weil er mit einem anderen Makro mehrere Zellen markiert hatte, somit das Worksheet_Change-Ereignis ausgelöst wurde und deshalb der Fehler auftrat. Meine Lösung war komischerweise genau die Zeile, die nun auch in Deinem Code vorkommt. Zufälle gib’s, oder etwa doch nicht? Solltest Du nun der Philip Thomas sein, dann hättest Du Dich wenigstens bedanken können. Denn zum Fragen hast Du meine Mail ja auch im Internet gefunden. Ansonsten vergiss den vorher geschriebenen Text und sorry.

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

Antwort 6 von Thomas81

Hallo coros,
danke fuer Deine Antwort! Genau der bin und es tut mir jetzt wirklich sehr leid, das Du denkst ich wuerde mich nicht bedanken aber ich habe es ausprobiert und hatte dann das Problem und habe es versucht hier im Forum zu loesen. Waere das nicht moeglich gewesen haette ich an meinen dank fuer Deine Hilfe gleich noch mal eine Frage gehabt. Hoffe naturlich Du glaubst mir das ich mich auf jeden Fall so oder so noch bedankt haette, Du hast mir wirklich weiter geholfen und ohne Deine Hilfe haette ich es wahrscheinlich nicht geschaft. Und es wuerde mich freuen wenn ich Dir bei einem eventuellen Problem genau so klasse weiter helfen koennte wie Du mir. Weil jetzt hat man ja wieder gesehen, zufaelle gibt es!
Nochmal danke!
viele Gruesse
Thomas

Antwort 7 von coros

Hallo Philip oder Thomas?

Freut mich, dass nun alles funktioniert. Danke Dir auch für die Rückmeldung.

MfG,
coros
Jeder macht was er will, keiner macht was er soll, aber alle machen mit.

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


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: