Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
552to556
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
552to556
552to556
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro einfügen aber wo ??

Makro einfügen aber wo ?
23.01.2005 09:10:48
Heinz
Guten morgen Leute
Habe von Makros leider "noch" soviel Ahnung wie ein Schwein vom Weitspringen.
Habe Dank Eurer Hilfe einiges weitergebracht. Aber nun stehe ich vor einer Mauer.
Habe im unterstehenden Link meine Mappe hochgeladen,nun würde die unterstehende Formel noch eingebaut gehören.Aber wo und wie?
Könnte mir BITTE jemand helfen.
Danke Heinz

Die Datei https://www.herber.de/bbs/user/16634.xls wurde aus Datenschutzgründen gelöscht

Option Explicit
'in das Tabellenmodul

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, [c6:c52]) Is Nothing Then
Call pause_akt_Z
ActiveCell.Offset(0, 3).Activate
End If
End Sub

'für die gesamte Tabelle
Public Sub pause_ges_Tab()
Dim wt As Byte, i%, x As Byte, optB$
Dim sh As Worksheet
Dim sh1 As Worksheet
Set sh = Worksheets("blatt")
Set sh1 = Worksheets("Legende")
For x = 1 To 5
If sh1.OLEObjects(x).Object = True Then
optB = sh1.OLEObjects(x).Name
End If
Next
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
For i = 6 To 52
wt = Weekday(sh.Cells(i, 2))

Select Case optB
Case "OptionButton1"
If wt = 2 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If

Case "OptionButton2"
If wt = 3 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If

Case "OptionButton3"
If wt = 4 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If

Case "OptionButton4"
If wt = 5 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If

Case "OptionButton5"
If wt = 6 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If

End Select

Next
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
'für die Eingabe in der Zeile
Sub pause_akt_Z()
Dim wt As Byte, i%, x As Byte, optB$
Dim sh As Worksheet
Dim sh1 As Worksheet
Set sh = Worksheets("blatt")
Set sh1 = Worksheets("Legende")
For x = 1 To 5
If sh1.OLEObjects(x).Object = True Then
optB = sh1.OLEObjects(x).Name
End If
Next
i = ActiveCell.Row
wt = Weekday(sh.Cells(i, 2))

Select Case optB
Case "OptionButton1"
If wt = 2 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If

Case "OptionButton2"
If wt = 3 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If

Case "OptionButton3"
If wt = 4 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If

Case "OptionButton4"
If wt = 5 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If

Case "OptionButton5"
If wt = 6 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If

End Select

End Sub

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro einfügen aber wo ?
23.01.2005 09:22:58
Josef
Hallo Heinz!
Das schaffst du doch selber!
Rechtsklick auf das Blattregister der entsprechenden Tabelle &gt Code anzeigen!
In das Fenster kopierst du dann diesen Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, [c6:c52]) Is Nothing Then
Call pause_akt_Z
ActiveCell.Offset(0, 3).Activate
End If
End Sub

Dann klickst du auf &gt Einfügen &gt Modul und kopierst den restlichen Code in
das neue Fenster. Fertig!
Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Anzeige
Sorry...
Ramses
hallo Josef
Du warst wohl schon am schreiben, während ich noch gelesen habe :-)
Gruss Rainer
AW: Sorry...
23.01.2005 09:34:51
Josef
Hallo Rainer!
Aber wiedermal gleiche Lösung;-))
Gruß Sepp
AW: Makro einfügen aber wo ?
23.01.2005 09:35:37
Heinz
Hallo Sepp
Dich schickt der Himmel.
Habe Deine Anleitung befolgt.
Nun habe ich die Fehlermeldung "Mehrdeutiger Name" Im Tabellenblatt.
Ich glaub die 2 Makros geörten jetzt in 1 Makro zusammen.
Könntest Du mir Bitte weiterhelfen.
Danke
Heinz

Private Sub CommandButton1_Click()
Sheets("Hauptblatt").Select
End Sub


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$A$6" Or Target.Address = "$A$52" Then
Dim neuer_Blattname As String
neuer_Blattname = Range("A6") & " bis " & Range("A52")
ActiveSheet.Name = neuer_Blattname
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, [c6:c52]) Is Nothing Then
Call pause_akt_Z
ActiveCell.Offset(0, 3).Activate
End If
End Sub

Anzeige
Was soll das eigentlich....
Ramses
Hallo
Die Frage hast du doch gestern schon gestellt, und sowohl Werner B und ich haben dir dort schon gesagt was es damit auf sich hat und Werner hat dir das Makro auch entsprechend umgebaut.
"Kaum EXCEL/VBA-Kenntnisse" sind dafür keine Entschuldigung ;-)
Gruss Rainer
AW: Was soll das eigentlich....
23.01.2005 09:58:23
Heinz
Hallo Rainer
Danke für Deine Hilfe
Sei nicht so hart zu mir, natürlich hast Du recht bezüglich Deiner Meldung "Die Frage hast du doch gestern schon gestellt, und sowohl Werner B und ich haben dir dort schon gesagt was es damit auf sich hat und Werner hat dir das Makro auch entsprechend umgebaut."
Aber in meiner Panik wusste ich nicht mehr weiter.
Schöne Grüsse
Heinz
Anzeige
Blödsinn...
Ramses
Hallo
"...Sei nicht so hart zu mir,..."
Werner hat dir gestern das genau gleiche geschrieben wie Josef gerade im anderen Beitrag.
"...Könntest Du mir ein Lehrmittel " Buch" empfehlen um ..."
Du brauchst bloss das zu machen was dir hier im Forum gesagt wird, das ist besser als ein Buch.
Mitlesen und Nachdenken wird dir auch ein Buch nicht abnehmen.
"...Aber in meiner Panik wusste ich nicht mehr weiter...."
Kein weiterer Kommentar :-(
Gruss
Rainer
AW: Makro einfügen aber wo ?
23.01.2005 09:39:10
Josef
Hallo HeinZ!
Die "Worksheet_Change" Codes musst du natürlich zusammenlegen!

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim neuer_Blattname As String
If Target.Address = "$A$6" Or Target.Address = "$A$52" Then
neuer_Blattname = Range("A6") & " bis " & Range("A52")
ActiveSheet.Name = neuer_Blattname
End If
If Not Intersect(Target, [c6:c52]) Is Nothing Then
Call pause_akt_Z
ActiveCell.Offset(0, 3).Activate
End If
End Sub

Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Anzeige
AW: Makro einfügen aber wo ?
23.01.2005 09:54:40
Heinz
Hallo Sepp
Danke jetzt funktionierts.
Könntest Du mir ein Lehrmittel " Buch" empfehlen um dieses VBA auch einmal zu verstehen & arbeiten zu können.
Schöne Grüsse
Heinz
AW: Makro einfügen aber wo ?
Ramses
Hallo
Einfache Anleitung
Mappe öffnen
"Alt"+"F11" drücken
Links im Projektexplorer "Doppelklick" auf die Tabelle wo du die Funktion benötigst und diesen Code

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, [c6:c52]) Is Nothing Then
Call pause_akt_Z
ActiveCell.Offset(0, 3).Activate
End If
End Sub

dort reinkopieren
Rechte Maustaste auf deine Mappe im Projektexplorer und "Einfügen - Modul" wählen.
Doppelklick auf das neu eingefügte Modul und den restlichen Code dort hinein kopieren.
Fertig
Gruss Rainer
Anzeige
AW: Makro einfügen aber wo ?
23.01.2005 09:39:32
Heinz
Hallo Rainer
Danke für Deine Anteilnahme,für unwissende "Ich"
Habe Deine Anleitung befolgt.
Nun habe ich die Fehlermeldung "Mehrdeutiger Name" Im Tabellenblatt.
Ich glaub die 2 Makros geörten jetzt in 1 Makro zusammen.
Könntest Du mir Bitte weiterhelfen.
Danke
Heinz

Private Sub CommandButton1_Click()
Sheets("Hauptblatt").Select
End Sub


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$A$6" Or Target.Address = "$A$52" Then
Dim neuer_Blattname As String
neuer_Blattname = Range("A6") & " bis " & Range("A52")
ActiveSheet.Name = neuer_Blattname
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, [c6:c52]) Is Nothing Then
Call pause_akt_Z
ActiveCell.Offset(0, 3).Activate
End If
End Sub

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige