Cursor springt zum aktuellen Datum
'im Beispiel steht das Datum in Spalte A, durchsucht wird die Zeile
1 bis 500
Sub auto_open()
spalte = "A"
For Each a In ActiveSheet.Range(spalte & "1:" & spalte
& "500")
If a = Date Then
zeile = a.Row
Exit For
End If
Next
On Error Resume Next
Application.Goto ActiveSheet.Cells(zeile, spalte), True
If Err.Number <> 0 Then
MsgBox ("Das aktuelle Datum wurde nicht gefunden.")
End If
End Sub
Seitenanzahl per Makro anzeigen
Sub seitenanzahl()
Dim i As Integer
i = ExecuteExcel4Macro("get.document(50)")
MsgBox "Anzahl der Seiten = " & i
End Sub
Geschütze Zellen nicht mehr anwählbar
'Cursorbewegung bei aktiviertem Blattschutz auf ungeschützte Zellen
beschränken
Private Sub Workbook_Open()
Worksheets("Tabelle1").EnableSelection = xlUnlockedCells
End Sub
oder für alle Tabellen in der Datei:
Sub auto_open()
Dim Sh As Worksheet
For Each Sh In Worksheets
Sh.Activate
With ActiveSheet
.EnableSelection = xlUnlockedCells
.Protect
End With
Next Sh
End Sub
Währungsformat linksbündig anzeigen
'mit folgendem Format wird das Währungsformat linksbündig
und der Betrag rechtsbündig in der Zelle angezeigt:
das Währungssymbol in Anführungszeichen setzen, ein Sternchen,
ein Leerzeichen und das gewünschte Zahlenformat, z.B.
"€"* #.##0,00
jede 2.Zeile farbig unterlegen
'kompletten Bereich markieren, in der Menüleiste unter Format die
bedingte Formatierung aufrufen. Das gewünschte Format einstellen,
unter Bedingung die Auswahl auf "Formel ist" ändern und
folgende Formel eingeben (z.B. A1= ist die linke obere Ecke des markierten
Bereichs):
=Zeile(A1)-Gerade(Zeile(A1))=0
Sonderzeichen auch in Excel anzeigen
Sub ZeichenTabelle()
Shell "charmap", 1
End Sub
Markierten Bereich in Euro umrechnen
'mit Änderung des Währungszeichens
Sub DM2Euro()
Dim C As Range
kurs = 1.95583
For Each C In Selection.Cells
If IsNumeric(C) Then
C = Application.Round(C / kurs, 2)
C.NumberFormat = "#,##0.00 [$€-1]"
End If
Next C
End Sub
Schaltflächentext von Zellinhalt
übernehmen
'Die Beschriftung der Schaltfläche ändert sich abhängig
vom Inhalt der angegebenen Zelle, wenn die Schaltfläche mit Hilfe
der Steuerelement-Toolbox eingefügt wird. Den Code der Schaltfläche
anzeigen lassen, im linken Kombifeld =Worksheets auswählen und die
eingefügten Zeilen durch folgende ersetzen:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
CommandButton1.caption=cells(1,1).value
End Sub
Zelle per Doppelklick einfärben
'Im Visual-Basic-Editor wählen Sie das gewünschte Tabellenblatt
aus, für welches das Ereignis gelten soll und fügen nachfolgendes
Makro ein:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
With Selection.Interior
.ColorIndex = 8
.Pattern = xlSolid
End With
End Sub
Zellinhalt nach dem Komma ausrichten
'mit folgendem Format werden verschieden lange Anzeigen am Komma ausgerichtet.
Sind mehr als 3 Stellen nach dem Komma möglich, weitere Fragezeichen
einfügen.
??0,0??
Kontextmenü nach eigenen Angaben erweitern
'folgende Makros in Sub Auto_open bzw. Sub Auto_close umbenennen, wenn
das angepaßte Menü nur für die vorliegende Datei gelten
soll und nicht als Add-In eingebunden wird.
Sub AddContextCmd()
Dim cb As CommandBar
Dim ctl As CommandBarControl
Set cb = CommandBars("Cell")
Set ctl = cb.Controls.Add()
With ctl
.Caption = "<angezeigter Befehlsname>"
.OnAction = "<Name des auszuführenden Makros>"
End With
End Sub
Sub DelContextCmd()
Dim cb As CommandBar
Dim ctl As CommandBarControl
On Error Resume Next
Set cb = CommandBars("Cell")
Set ctl = cb.Controls("<angezeigter Befehlsname>")
ctl.Delete
End Sub
Kombinationsfelder mit Inhalt anzeigen
'Den ausgewählten Listeneintrag (und nicht die Position des Listeneintrags)
erhalten Sie mit der zusätzlichen Formel =Index(A1:A10;B1). Soll
der Eintrag direkt ausgegeben werden, dem Kombifeld zusätzlich folgendes
Makro zuweisen:
Sub dropdown1_BeiÄnderung()
If IsNumeric(Cells(1, 2).Value) = True Then
listwert = Tabelle1.Cells(Cells(1, 2).Value, 1).Value
Tabelle1.Cells(1, 2).Value = listwert
End If
End Sub
Tabellenblätter nach Farben sortieren
Sub Farbsortierung()
Dim i As Long, j As Long
For i = 1 To Worksheets.Count - 1
For j = i To Worksheets.Count
If Worksheets(j).Tab.ColorIndex = _
Worksheets(i).Tab.ColorIndex Then
Worksheets(j).Move After:=Worksheets(i)
End If
Next j
Next i
End Sub
Leerzellen einer Liste nachträglich ausfüllen
Den Bereich markieren, dessen Leerzellen ausgefüllt werden sollen.
In der Menüleiste "Bearbeiten - Gehe zu" wählen, auf
die Schaltfläche "Inhalte" klicken und die Option "Leerzellen"
auswählen. Jetzt das Gleichheitszeichen eingeben, die Zelladresse
oberhalb der ersten Leerzelle eingeben und mit STRG und Return abschließen.
Excel füllt nun alle Leerzellen mit dem jeweils darüberliegenden
Zellinhalt aus.
Scrollbereich festlegen
'mit folgendem Autostart-Makro wird ein ungeschützter Bereich festgelegt.
Außerhalb des Bereichs sind keine Änderungen oder Markierungen
mehr möglich.
Private Sub Workbook_Open()
Worksheets(1).ScrollArea = "A1:D25"
End Sub
Eingabe in festgelegtem Bereich nicht möglich
'eine Markierung bzw. Eintragung in Spalte 3 ist in folgendem Beispiel
nur dann möglich, wenn in D1 "OK" steht.
Private Sub Worksheet_SelectionChange(ByVal Target _
As Range)
Application.EnableEvents = False
If Target.Column = 3 Then
If Range("D1").Value <> "OK" Then
Range("A1").Activate
End If
End If
Application.EnableEvents = True
End Sub
|
