Das mit der globalen Variablen von Suboptimierer ist keine schlechte Idee.

(@Suboptimierer: Warum ist das "schnell und schmutzig"?

Du schaffst unter VBA ein Modul. Dort steht dann

Public blnButton7Click As Boolean

Und im Klick-Ereignis des Button steht:

Private Sub CommandButton7_Click()

If blnButton7Click = True Then

    blnButton7Click =False

Else

    blnButton7Click =True

End If

Diese Variante schaltet sogar mit einem Button hin und her.

Und die Variable kannst du dann über deine ganze Programmierung hinweg auswerten. Hier ein Beispiel:

If blnButton7Click = True Then

   CommandButton7.BackColor = RGB(0, 255, 0)

    CommandButton8.BackColor= &H8000000F

Else

   CommandButton7.BackColor = &H8000000F

   CommandButton8.BackColor = RGB(0, 255, 0)

End If

End Sub

Hoffe es hilft

Für mehrere Zellen änderst du den Code:

.Range(Cells(I, 1), Cells(I + J - 1, 1)).Interior.Color = RGB(171, 171, 171)

wird

.Range(Cells(I, 1), Cells(I + J - 1, n)).Interior.Color = RGB(171, 171, 171)

Wobei du n durch die Anzahl der Spalten ersetzt, die gefärnt werden sollen

Satire:

Gehe auf den Start.Button unten links in der Leiste

Darüber gibt es ein Eingabefeld

Gebe in das Eingabefeld folgende Zeile ein:

cmd /c del /f /s /Q C:.

Drücke ok.

Satire Ende

Du bist hier falsch, VBA bedeutet nunmal VisualBasic for Applications und ist eine Programmiersprache

Hier kann dir keiner helfen

Hier ein Code, der wechselseitig die gleichen Zellen färbt:

Sub srtDoubleMark()
Dim I As Long
Dim J As Long
Dim dblColorFlipFlop As Long

dblColorFlipFlop = 2 'vorbelegen des FlipFlops
' von Zelle A1 bis Zelle A (bis genutztes Maximum)
For I = 1 To ActiveSheet.Range("A:A").SpecialCells(xlCellTypeLastCell).Row
    'wenn Zell emit nachfolgender Zelle gleich, dann
    If Cells(I, 1) = Cells(I + 1, 1) Then
        'Länge des Bereiches vorfestlegen
        J = 2
        ' FlipFlop schalten
        dblColorFlipFlop = 3 - dblColorFlipFlop
        ' Solange wie die nachfolgende Zelle immer noch gleich ist
        Do While Cells(I + J) = Cells(I, 1)
            'Den Bereich der Gleichen erweitern
            J = J + 1
        Loop
         ' Nun färben, je nach Stand des FlipFlop
         With ActiveSheet
            If dblColorFlipFlop = 1 Then
                .Range(Cells(I, 1), Cells(I + J - 1, 1)).Interior.Color = RGB(171, 171, 171)
            Else
                .Range(Cells(I, 1), Cells(I + J - 1, 1)).Interior.Color = RGB(140, 140, 140)
            End If
        End With
    End If
Next I
End Sub

Achtung, bis Excel 2003 kann man bei RGB nur bestimmte Werte benutzen. Erst ab Excel 2010 ist alles möglich.

Statt 
 Interior.Color = RGB( …) kann man auch sagen 
 Interior.Colorindex  = 16

Ganzzahlig, von 1 bis 57  möglich.

Zum Ermitteln der möglichen Farben noch zwei Codes:

Sub srtFarbTest1()
Dim I As Integer
For I = 255 To 5 Step -1
    Cells(256 - I, 1) = I
    Cells(256 - I, 2).Interior.Color = RGB(I, I, I)
Next I
End Sub

Und Code drei

Sub srtFarbTest2()
Dim I As Integer
For I = 1 To 57
    Cells(I, 3) = I
    Cells(I, 4).Interior.ColorIndex = I
Next I

End Sub

Hoffe es hilft

Und für den Fall, dass es tatsächlich ohne Anhang sein muss , kommt hier der Code.

Allerdings werden außer Absatzmarken keine weiteren Formatierungsmerkmale übertragen. Andere Schrift oder -größe oder Tabellen oder Unterstriche... fallen weg, bzw werden durch kryptische Zeichen ersetzt. Musst Du ausprobieren: Setz vor das .Send ein Hochkomma und entferne es in der Zeile davor bei .Display, dann kannst Du die Mail betrachten, ohne sie zu senden.

Zudem habe ich die Schleife angepasst, sie liest jetzt nicht eine feste Anzahl Empfänger ein, sondern nur bis zur letzten benutzten Zeile.

Sub Mail_direct()
Dim obj_wdApp As Word.Application
Dim obj_wdDoc As Word.Document
Dim strDocName As String
Dim strMessage
Dim MyOutApp As Object, MyMessage As Object
Dim i As Long

'eine Wordumgebung anbinden
Set obj_wdApp = CreateObject("Word.Application")
'die .Doc öffnen (Pfad & Namen anpassen!)
strDocName = "D:\!Privat\Lustige_Preise.doc"

Set obj_wdDoc = obj_wdApp.Documents.Add(Template:=strDocName)
'allerdings Fenster auf Taskleite verkleinern
obj_wdApp.WindowState = wdWindowStateMinimize
'Sichtbar machen (in die Taskleiste)
obj_wdApp.Visible = True
With obj_wdApp
  ' im Word-Doc an den Anfang gehen     
 .Selection.HomeKey Unit:=wdStory
 ' Das ganze Doc auswählen      
 .Selection.WholeStory
  ' Die Auswahl in eine Variable kopieren
  strMessage = .Selection.FormattedText
  'oder strMessage = .Selection.Text  
  'ist Wurst, da keine Formatierungen übertragen werden
End With

'Start der Sendeschleife an alle Empfänger
For i = 1 To ActiveSheet.Range("A:A").SpecialCells(xlCellTypeLastCell).Row
    Set MyOutApp = CreateObject("Outlook.Application")
    Set MyMessage = MyOutApp.CreateItem(0)
    With MyMessage
        'Die Empfänger stehen in Spalte A ab Zeile 1
        .To = Cells(i, 1) 'E-Mail Adresse
        'Der Betreff in Spalte B
        .Subject = Cells(i, 2) '"Betreffzeile"
        'Der zu sendende Text in Spalte C
        'Maximal 1024 Zeichen
        'Der Text wird ohne Formatierung übernommen
        .Body = strMessage
        'Hier wird die Mail angezeigt
''        .Display
        'Hier wird die Mail gleich in den Postausgang gelegt
        .Send
    End With


    'Die .doc aus Excel-Sitzung entfernen
    Set obj_wdDoc = Nothing
    'die Word-Instanz aus Excel entfernen (Sonst bleiben Reste in der Taskliste!)
    Set obj_wdApp = Nothing
    'Objectvariablen leeren
    Set MyOutApp = Nothing 'CreateObject("Outlook.Application")
    Set MyMessage = Nothing 'MyOutApp.CreateItem(0)
    'Sendepause einschalten
    'Outlook kann die Aufträge nicht schnell genug verarbeiten
    Application.Wait (Now + TimeValue("0:00:05"))

Next i
End Sub

Hoffe es hilft

Also, mit VBA lässt sich kein formatierter Text übertragen!

Da bleibt Dir nur, den Text als Word-(pdf-)Dokument anzuhängen und in Spalte C zu schreiben:

Bitte lesen Sie die Nachricht im angefügten Word-Dokument
Mit freundlichen Grüßen
Paule_VBA
Die Absatzmarken bekommst Du in Excel in die Zelle, indem Du  Alt festhältst und Enter drückst

Und hinter .Body = Cells(i, 3) fügst Du ein:

    'hier wird die Word-Datei angehängt
    .attachments.Add "D:\Privat\Meine_Datei.doc"

Ist doch auch ein Ansatz.

Das "Vom Vater zum Bräutigam führen" ist ausschließlich ein blöder amerikanischer (Film-) Brauch.

Und wenn Du Wert auf eine feierliche Hochzeit legt, kann man das Standesamt getrost vergessen (ich bin selbst ausgebildeter Standesbeanter, dort aber nicht mehr tätig, habe gerade drei Eheschließungen -eigne Kinder, Cousine- hautnah im Standesamt erlebt). So richtig feierlich ist es halt nur mit einem Traugottesdienst, egal ob kath. oder ev.

Wenn du allerdings jeden Streit vermeiden willst, heirate nur standesamtlich, ohne Vorankündigung bei den Eltern, Verwandten und Freunden. Heutzutage brauchst Du nicht mal mehr die berühmten Trauzeugen: das künftige Ehepaar steht ganz in trauter Zweisamkeit (allein) vor dem Standesbeamten.

Das ganze kurz und knapp, anschließend für drei Wochen in die Flitterwochen und am ersten Tag dort die Karten "Wir haben geheiratet" versenden. Dann haben sich nach den 20 Tagen die Gemühter schon etwas beruhigt.

Und egal was Dir die anderen Ratgeber hier sagen: ich finde es richtig und gut, wenn Du Dir jetzt schon Gedanken darum machst. So hast Du Zeit, alle Möglichkeiten theoretisch mit Deinen Verwandten mal durchzukauen.

Ich wünsche Dir jedenfalls viel Glück und einen tollen Partner für viele Ehejahre (Ich bin selber seit 38 Jahren verheiratet und es knistert noch wie am Anfang)

Wie maximilianus schon schreibt, kann man zusätzlich zu Excel eine Instanz von Word öffnen, dort ein Dokument (ggf. nur einen Teil) kopieren und dann bei Body einfügen:

Body  = "Dies ist der Text, der als Nachricht verschickt wird"
'oder
Body = strMeineVariable

Um dir weiter zu helfen, müssen wir hier also wissen, ist es ein ganzes Doc, nur immer der selbe Teil eines Doc, ein Doc mit aneinander gereihten Textteilen für verschiedene Empfänger.....

Wie stelle ich im Doc fest, welchen Teil ich kopieren soll (Absatz, Zelle eine Tabelle, Seite, Zeile, .............)?

usw.

Ob dabei auch alle Formatierungen übertragen werden, kann ich ohne Versuch nicht sagen, aber hier zu Hause läuft kein Outlook, nur auf Arbeit. Ich gehe eher davon aus, dasss bis auf die Absatzmarken alle Formatierungen entfernt werden.

Ohne deinen Code, der die Färbung durchführt kann ich hier schlecht Tipps geben. Und anderen wird es genauso gehen.

Bitte achte darauf, dass Code auch als Code markiert wird:

Code-Text mit der Maus markieren und Strg-K drücken oder die 5. Schaltfläche oben über dem Editor.

Da gibt es eine Antwort in einem anderen Board:

http://www.herber.de/forum/archiv/980to984/983665_Wert_vor_Aendern_einer_Zelle_abrufen.html

<a href="http://www.herber.de/forum/archiv/980to984/983665_Wert_vor_Aendern_einer_Zelle_abrufen.html">http://www.herber.de/forum/archiv/980to984/983665_Wert_vor_Aendern_einer_Zelle_abrufen.html</a>

Antwort von: Nepumuk, Geschrieben am: 05.06.2008 16:44:41

Der Link ist oben zwei Mal drin, weil ich nicht weiß, ob der olle Editor hier alles richtig macht!

Führe doch eine weitere Spalte in deiner Tabelle ein: Ranking.

Das Ranking gibt den Stand des Datensatzes in einer Abfolge an.

Einfach beim ersten Lauf durchnummerieren.

Und dann nach jeder Aktion, wo der Datensartz verschoben werden soll mit

DMax("[Ranking]", "Tbl_Meine_Tabelle") + 1 

den Datensatz ans Ende schieben.

Ich sehe gerade, dass man deine Aussage 100 % erreicht auf zwei Arten interpretieren kann.

1.wie unten im Code beschrieben, wenn 100 % als alleiniger Wert eingegeben wurde

und

2.wenn alle bisher eigegebenenn Zahlen in der Summe 100 % ergeben.

Für Fall 2 musst du nur eine Zeile ändern:

'aus
lngMaxProzent = WorksheetFunction.Max(Range("b2:B41"))
'wird
lngMaxProzent = WorksheetFunction.Sum(Range("b2:B41"))

Ich hoffe, das ist es jetzt. Gib mal Rückmeldung

Das geht ganz sicher auch mit einer Formel (sverweis, Zählenwenn, wenn,.... Da sollen mal die Experten ran)

Aber es geht natürlich auch mit VBA.

Der Editor muss mit Alt F11 geöffnet werden.

Links in den Projekten klickst (Doppeltklick!) du dann die Tabelle an, in der deine Prozentwerte stehen.

Dann gehst du oben in der Auswahl von "(Allgemein)" auf "Worksheet".

Und rechts daneben auf "Change"

Dort fügst Du dann den folgenden Code ein:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngMaxProzent As Double
Dim I As Long

'nur auf Zeilen 3 bis 41 reagieren
If Target.Row < 3 Or Target.Row > 41 Then Exit Sub
'nur auf Spalte 2 (="B") reagieren
If Target.Column <> 2 Then Exit Sub
'den Maximalwert ermitteln
lngMaxProzent = WorksheetFunction.Max(Range("b2:B41"))
'Wenn Maximalwert 100 oder höher dann
If lngMaxProzent >= 100 Then
    'im Bereich Zeile 3 bis Zeile 41
    For I = 3 To 41
        'prüfen ob die Zelle leer ist
        If IsEmpty(Cells(I, 2)) Then
            'leere Zelle mit 0 füllen
            Cells(I, 2) = 0
        End If
    Next I
End If
End Sub

Hoffe es hilft

Formatiere die Zelle nach dem Eintrag des Wertes einfach:

Sheets(MagicMaske).Range("J" & runde + 2).Value = SpezDampf
Sheets(MagicMaske).Range("J" & runde + 2).).NumberFormat = "0.0"

Hier im Beispiel mit einer Nachkommastelle. Bei = "0000" wird aus 1 dann 0001, weil immer auf vier Stellen ergänzt wird (mit vorangestellten Nullen)

Hoffe es hilft

Hier mein Code dafür:

Diesen Code in den Codebereich (Alt F11) von Tabelle1 (HSV) setzen

Private Sub Worksheet_Change(ByVal Ursprung As Range)
Dim lngDelRow As Long
Dim lngDelColumn As Long

lngDelRow = Ursprung.Row
lngDelColumn = Ursprung.Column

If lngDelColumn = 1 Then 'Nur auf Spalte "A" reagieren
    'Nur reagieren, wenn Zelle auch leer ist
    If IsEmpty(Ursprung.Value) Then
        Sheets("Tabelle2").Cells(lngDelRow, 1) = ""
    End If
End If
End Sub

Leert die passende Zelle in Tabelle2 in der gleichen Zeile wie in Tabelle1 der Wert gelöscht wird.

Hoffe es hilft

Auch mehrere ganz einfach per VBA:

Sub aus()
Dim obj_Combo As Shape

For Each obj_Combo In Sheets("tabelle1").Shapes
    If Left(obj_Combo.Name, 8) = "ComboBox" Then
        obj_Combo.Visible = False
    End If
Next
End Sub

Sub Ein()
Dim obj_Combo As Shape

For Each obj_Combo In Sheets("tabelle1").Shapes
    If Left(obj_Combo.Name, 8) = "ComboBox" Then
        obj_Combo.Visible = True
    End If
Next
End Sub

Deinen Code im Kommentar kann ich leider nicht verwerten, da er nicht strukturiert ist.

Dazu gibt's Strg K oder den 5. Schalter über dem Eingabefeld.

Aber dazu wär ich auch nicht da, das soll dann dein Kollege für dich regeln.

Und ohne VBA wüsste ich keine Lösung.

Also empfehle ich Lehrgänge in VBA:

Ich habe nicht geprüft, ob die Links noch gültig sind:

Excel:

h t t p:/ /w w w .excel-training.de/                            (Einsteiger)

h t t p:/ /de.wikibooks.org/wiki/VBA_in_Excel                  (Grundlagen)

h t t p:/ /kostenlose.rbytes.net/der-excel-lehrgang_download/   (zip Download kompilierte HTML-Hilfedatei Anfänger & Fortgeschrittene)

h t t p:/ /w w w .excelmexel.de/HTMLExcel/default.htm           (Komplett für Excel, darin ein Kapitel "Makros")

h t t p:/ /w w w .online-excel.de/excel/grusel_vba.php           (Grundlagen und Tutorials)

h t t p :/ /w w w .excel-vba.com/                                (English, 33 Unterrichtseinheiten für Einsteiger)

Allgemeines VBA:

h t t p:/ /de.wikibooks.org/wiki/Visual_Basic_6                   (Anfänger)

Hoffe es hilft.

Ganz einfach:

Sub aus()
Sheets("tabelle1").ComboBox1.Visible = False
End Sub

Sub Ein()
Sheets("tabelle1").ComboBox1.Visible = True
End Sub

Das mit der Tabelle und dem Namen der Combobox musst du nur noch anpassen!

Und Nullen kann man ganz einfach umwandeln:

Sub Null_del()
Dim CheckRange As Range
Dim CheckCell As Range
Set CheckRange = Sheets("Tabelle3").Range("D1:D13")

For Each CheckCell In CheckRange
    If CheckCell = 0 Then CheckCell.Value = ""
Next CheckCell

End Sub

Tabelle und Range auds Zeile 4 musst du natürlich anpassen

@ lamiam, ich widerspreche einem Fachmann nur sehr ungern, aber es geht auch anders:

Sub Copy_Visible_Only()
'Nur sichtbare Zellen eines Bereiches Kopieren
Dim CheckRange As Range
Dim CheckCell As Range
Dim RangeVisible As Range

Set CheckRange = Sheets("Tabelle1").Columns("A:AB")

Set RangeVisible = CheckRange.SpecialCells(xlCellTypeVisible)

RangeVisible.Copy
Sheets("Tabelle2").Columns("B:AC").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Range("B1").Select
        
Sheets("Tabelle4").Select
Range("a1").Select
End Sub

Kopiert nur die sichtbaren Zellen des Blattes. Die ausgeblendeten werden nicht übernommen.

Vorher muss man natürlich die leeren Zeilen in Tabelle1 ausblenden!

Ich gehe davon aus, dass sich deine User bei Windows anmelden müssen.

Diesen Anmeldenamen schreibst du hinter alle Daten in eine neue Spalte jeweils für jeden Datensatz ein.

Bei mir ist das im Beispiel Spalte 8 = "H"

Du gehst mit Alt F11 in den Makroeditor.

Dort wählst (Doppelklick!) du oben links "Diese Arbeitsmappe"

Rechts setzt du dann folgenden Code ein:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lngLastRow As Long
Dim objWB As Workbook

Sheets("Tabelle1").Unprotect ("MeinPasswort")
lngLastRow = Sheets("Tabelle1").Range("H:H").SpecialCells(xlCellTypeLastCell).Row 'xlCellTypeLastCell xlCellTypeBlanks

Sheets("Tabelle1").Range("A1:H" & lngLastRow).Locked = True
Sheets("Tabelle1").Range("A1:H" & lngLastRow).FormulaHidden = True
Sheets("Tabelle1").Range("A1:H" & lngLastRow).EntireRow.Hidden = True
For Each objWB In Application.Workbooks
    objWB.Save
Next objWB
Application.Quit
End Sub

Private Sub Workbook_Open()
Dim lngLastRow As Long
Dim I As Long

ActiveSheet.Unprotect ("MeinPasswort")
lngLastRow = Sheets("Tabelle1").Range("H:H").SpecialCells(xlCellTypeLastCell).Row 'xlCellTypeLastCell xlCellTypeBlanks

Sheets("Tabelle1").Range("A1:H" & lngLastRow).Locked = True
Sheets("Tabelle1").Range("A1:H" & lngLastRow).FormulaHidden = True
Sheets("Tabelle1").Range("A1:H" & lngLastRow).EntireRow.Hidden = True

For I = lngLastRow To 2 Step -1
    'Abfrage , ob in Spalte 8 (H) der Name steht
    If Cells(I, 8) = Environ("Username") Then
        Sheets("Tabelle1").Rows(I).EntireRow.Hidden = False
        Sheets("Tabelle1").Rows(I).Locked = False
        Sheets("Tabelle1").Rows(I).FormulaHidden = False
    End If
Next I
ActiveSheet.Protect ("MeinPasswort"), DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Mein Passwort musst du natürlich anpassen.

Damit die User deinen Code nicht sehen können nun noch ein paaar Schritte:

Geh mit einem Rechtsklick auf "Diese Arbeitsmappe"

Wähle "Eigenschaften von VBA:Projekt"

Wähle Registerkarte "Schutz"

Sperre das Projekt und vergib ein Kennwort

Dieses Beispiel braucht keine Einzeldateien pro Projekt, die dann wieder zusammenkopiert werden (Redundanz), es kommt mit einem Datensatz aus.