22.07.2010

ComboBox - Steuerelemente!

Bei Eingabe in Spalte A wird automatisch eine ComboBox aus Steuerelemente (ActiveX) in Spalte K erstellt. Code gehört in den Codebereich des Tabellenblattes.

ComboBox - Steuerelemente...

Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objBox As OLEObject
Dim blnTMP As Boolean
Dim shpBox As Shape
If Target.Column <> 1 Or Target.Count > 1 Then Exit Sub
For Each shpBox In ActiveSheet.Shapes
If shpBox.TopLeftCell.Cells.Row = Target.Row Then
blnTMP = True
End If
Next shpBox
If Not blnTMP = True Then
Set objBox = ActiveSheet.OLEObjects.Add(ClassType:= _
"Forms.ComboBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=Target.Offset(0, 10).Left, _
Top:=Target.Offset(0, 10).Top, _
Width:=72, Height:=18)
End If
blnTMP = False
End Sub

Excel - MYSQL!

Hier mal zwei Themen wo es um die Verbindung zwischen Excel und MYSQL geht.

Excel - MYSQL...

Excel - MYSQL Next...

Excel - Word - UserForm!

Folgender Code schreibt den Wert aus Tabellenblatt "Sheet1", Zelle "A1" in die "TextBox1" der "UserForm1" in der Templatedatei "C:\Temp\Doc1.dotm" - also entsprechend anpassen.

Excel - Word - UserForm...

Code:
Option Explicit
Sub Test()
Dim strPath As String
Dim objTB As Object
Dim oWord As Object
On Error GoTo Fin
Set oWord = CreateObject("Word.Application")
strPath = "C:\Temp\Doc1.dotm"

With oWord
.WordBasic.DisableAutoMacros 1
.Documents.Add Template:=strPath, NewTemplate:=False
.Visible = True
'.Activate 
Set objTB = .Documents.Application.Templates.Item(strPath). _
VBProject.VBComponents("UserForm1").Designer.Controls("TextBox1")
objTB.Text = ThisWorkbook.Worksheets("Sheet1").Range("A1")
End With
Fin:
Set objTB = Nothing
Set oWord = Nothing
End Sub

Lokal-Fenster!

Erste Anlaufstelle, wenn ich Informationen über meine Variablen haben möchte ist das "Lokal-Fenster". Erst die Subs "Test()" und "Test_1()" rennen lassen, dann Sub "Test_2()" (VBA-Editor - Ansicht - Lokal-Fenster).

Lokal-Fenster...

Code:
Option Explicit
Public Sub Test()
Dim shpObject As Shape
Set shpObject = ActiveSheet.Shapes.AddShape( _
msoShapeRectangle, 20, 20, 20, 20)
shpObject.Line.ForeColor.RGB = RGB(255, 0, 0)
Set shpObject = Nothing
End Sub
Public Sub Test_1()
Dim shpObject As Shape
Set shpObject = ActiveSheet.Shapes.AddShape( _
msoShapeOval, 20, 20, 30, 40)
shpObject.Line.ForeColor.RGB = RGB(255, 0, 0)
Set shpObject = Nothing
End Sub
Public Sub Test_2()
Dim shpObject As Shape
For Each shpObject In ActiveSheet.Shapes
Stop
Next shpObject
End Sub

Selection = Hyperlink!

In einer Zelle, oder einem Zellenbereich, steht z. B. "C:\Temp\Test.pdf". Alle mit der Maus markierten Zellinhalte sollen in Hyperlinks umgewandelt werden. Code unten noch etwas angepasst.

Selection = Hyperlink...

Code:
Option Explicit
Public Sub Link()
Dim rngRange As Range
For Each rngRange In Selection
If Dir(rngRange.Text) <> "" Then
ActiveSheet.Hyperlinks.Add _
Anchor:= _
Cells(rngRange.Row, rngRange.Column), _
Address:= _
Cells(rngRange.Row, rngRange.Column), _
TextToDisplay:= _
Mid(Cells(rngRange.Row, rngRange.Column), _
InStrRev _
(Cells(rngRange.Row, rngRange.Column), "\", -1) + 1)
Else
rngRange.Font.ColorIndex = 3
End If
Next rngRange
End Sub
Public Sub Link_1()
Dim rngRange As Range
For Each rngRange In Selection
If Dir(rngRange.Text) <> "" Then
ActiveSheet.Hyperlinks.Add _
Anchor:= _
Cells(rngRange.Row, rngRange.Column).Offset(0, 1), _
Address:= _
Cells(rngRange.Row, rngRange.Column), _
TextToDisplay:= _
Mid(Cells(rngRange.Row, rngRange.Column), _
InStrRev _
(Cells(rngRange.Row, rngRange.Column), "\", -1) + 1)
Else
rngRange.Font.ColorIndex = 3
End If
Next rngRange
End Sub
Public Sub Link_2()
Dim rngRange As Range
For Each rngRange In Selection
If Dir(rngRange.Text) <> "" Then
ActiveSheet.Hyperlinks.Add _
Anchor:= _
Cells(rngRange.Row, rngRange.Column), _
Address:= _
Cells(rngRange.Row, rngRange.Column)
Else
rngRange.Font.ColorIndex = 3
End If
Next rngRange
End Sub
Public Sub Link_3()
Dim rngRange As Range
For Each rngRange In Selection
If Dir(rngRange.Text) <> "" Then
ActiveSheet.Hyperlinks.Add _
Anchor:= _
Cells(rngRange.Row, rngRange.Column).Offset(0, 1), _
Address:= _
Cells(rngRange.Row, rngRange.Column)
Else
rngRange.Font.ColorIndex = 3
End If
Next rngRange
End Sub

Verweise - ADO!

Alle gesetzten Verweise auslesen mit Beschreibung, Name, GUID und Pfad. Danach den Verweis auf "Microsoft ActiveX Data Objects 2.8 Library" setzen.

Verweise - ADO...

Code:
Option Explicit
Public Sub Read_Ref()
Dim objTMP As Object
Dim objRef As Object
Set objRef = ThisWorkbook.VBProject.References
For Each objTMP In objRef
With objTMP
Debug.Print .Description
Debug.Print .Name
Debug.Print .GUID
Debug.Print .fullpath
Debug.Print "NEXT REF"
End With
Next objTMP
End Sub
Public Sub Ref_ADO()
Dim objTMP As Object
On Error Resume Next
Set objTMP = ThisWorkbook.VBProject.References
'Microsoft ActiveX Data Objects 2.8 Library
objTMP.AddFromGuid _
"{2A75196C-D9EB-4129-B803-931327F72D5C}", 1, 0
End Sub
'Microsoft ActiveX Data Objects 2.8 Library
'{2A75196C-D9EB-4129-B803-931327F72D5C}

'Microsoft ADO Ext. 2.8 for DDL and Security
'{00000600-0000-0010-8000-00AA006D2EA4}

'Microsoft ActiveX Data Objects 6.0 Library
'{B691E011-1797-432E-907A-4D8C69339129}

'Microsoft ADO Ext. 6.0 for DDL and Security
'{00000600-0000-0010-8000-00AA006D2EA4}

21.07.2010

Shape(s) - Gruppieren!

Bestimmte oder alle Shapes gruppieren (Group).

Shape(s) - Gruppieren...

Access - Tabellen - Spalten - auslesen!

Aus einer wählbaren Accessdatei sollen die Tabellen- und Spaltennamen ausgelesen werden. Code im Link ist "Early Binding" - deshalb unten nochmal mit "Late Binding" - also ohne Verweise.

Access - Tabellen - Spalten - auslesen...

Option Explicit
Public Sub Test()
Dim objCatalog As Object
Dim objConn As Object
Dim objTable As Object
Dim intCount As Integer
Dim varFile As Variant
Dim lngCount As Long
On Error GoTo Fin
lngCount = 1
Set objConn = CreateObject("ADODB.Connection")
Set objCatalog = CreateObject("ADOX.Catalog")
varFile = Application.GetOpenFilename("Access,*.mdb")
If varFile = False Then Exit Sub
objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & varFile
objCatalog.ActiveConnection = objConn
For Each objTable In objCatalog.Tables
If objTable.Type = "TABLE" Then
Cells(lngCount, intCount + 1).Value = objTable.Name
Cells(lngCount, intCount + 1).Font.Bold = True
For intCount = 0 To objTable.Columns.Count - 1
Cells(lngCount, intCount + 2).Value = _
objTable.Columns.Item(intCount).Name
Next intCount
lngCount = lngCount + 1
intCount = 0
End If
Next objTable
Fin:
If Err.Number <> 0 Then MsgBox "Error " & _
Err.Number & " (" & Err.Description & ")"
If Not objConn Is Nothing Then
If objConn.State = 1 Then objConn.Close
End If
Set objCatalog = Nothing
Set objConn = Nothing
Columns.AutoFit
End Sub

Shapes - Pfeil - erstellen - drehen!

Ein Shape - hier ein Pfeil - wird erstellt und über eine Zahleneingabe in A1 gedreht.

Shapes - Pfeil - erstellen - drehen...

Tabellenblätter als Datei speichern!

Alle Tabellenblätter einer Datei sollen einzeln als Datei gespeichert werden - Name der Datei entspricht dem jeweiligen Tabellenblattnamen.

Tabellenblätter als Datei speichern...

UserForm - ComboBox - TextBox!

In einer UserForm wird über eine ComboBox eine Auswahl getroffen. Die korrespondierenden Zellen werden dann in TextBoxen angezeigt.

UserForm - ComboBox - TextBox...

Autofilter - Kriterien auslesen!

Die eingestellten Kriterien des Autofilters sollen ausgelesen werden.

Autofilter - Kriterien auslesen...

Diagramm - Chart - Einblenden - Ausblenden!

Über einen "ToggleButton" wird ein Diagramm aus- bzw. eingeblendet.

Diagramm - Chart - Einblenden - Ausblenden...

Auslesen Werte alle Dateien!

Aus allen Dateien eines Ordners sollen bestimmte Bereiche in eine Masterdatei eingelesen werden.

Auslesen Werte alle Dateien...

BuiltinDocumentProperties - Kommentar!

Text aus einer TextBox soll in den Kommentar der "BuiltinDocumentProperties" geschrieben werden.

BuiltinDocumentProperties - Kommentar...

Worksheet_Change - Intersect!

Die Gültigkeit eines Codes aus "Worksheet_Change" mit Intersect auf bestimmte Zeilen einschränken.

Worksheet_Change - Intersect...

Ordner erstellen - Liste in Spalte A!

Es geht hier um eine Liste in Spalte A. Nach dieser Liste sollen Ordner mit Unterordner angelegt werden.

Ordner erstellen - Liste in Spalte A...

19.07.2010

Mail - mehrere Tabellenblätter und Empfänger!

Immer wieder gefragt - Mail aus Excel. Warum das Rad nochmal erfinden? :-)

Mail - mehrere Tabellenblätter und Empfänger...

Webabfrage - TAGS auslesen!

Aus einer Internetseite sollen bestimmte "TAGs" ausgelesen werden.

Webabfrage - TAGS auslesen...

Ordner anlegen!

Ordner sollen angelegt werden. Hier wird mit der API - Funktion "MakeSureDirectoryPathExists" gearbeitet. Der Vorteil dieser Funktion ist, dass keine Fehlermeldung ausgegeben wird, wenn der Ordner schon vorhanden ist. Auch können Ordner in mehreren Tiefen auf einen Schlag angelegt werden.

Ordner anlegen - API...

Ordner anlegen - Next - API...

Zeilen löschen - Bedingung!

In umfangreichen Datenbeständen (> 60.000 Datensätze) sollen Zeilen unter bestimmten Bedingungen gelöscht werden.

Zeilen löschen - Bedingung...

Bild - Formeleditor - Kommentar!

Ein eingebettetes Objekt (Formeleditor) soll als Bild im Kommentar dargestellt werden.

Bild - Formeleditor - Kommentar...

UserForm - Laufzeit!

Zur Laufzeit werden einer UserForm über eine schon vorhandene ComboBox TextBoxen hinzugefügt bzw. wieder gelöscht.

UserForm - TextBox - Laufzeit...

Code - Makro in Datei importieren!

Probleme, wenn Code aus "DieseArbeitsmappe", der exportiert wurde, in eine andere Datei importiert werden soll. Hier umgangen in dem die "*.CLS - Datei" als Textdatei eingelesen wird.

Code - Makro importieren...

Ordner - API!

Ordnerauswahl über API mit "SHBrowseForFolder" bzw. "SHGetPathFromIDList".

API Ordner auswählen...

Tabellen - Daten verteilen!

Aus Daten automatisch Tabellenblätter generieren und Daten kopieren. In diesem Beispiel sind es AGs in einem Kindergarten. Es wurde zusätzlich zu VBA mit "Daten - Datenüberprüfung" und Namen "Formeln - Namensmanager" gearbeitet.

Tabellen generieren...

Formeln auf einer UserForm in einer TextBox darstellen...

Formeln auf einer UserForm in einer TextBox anzeigen. Z. B. "Formula", "FormulaLocal"... und wie muss die Formel in VBA ...