Posts

Es werden Posts vom März, 2011 angezeigt.

Geschlossene Dateien - Datum - Bedingung!

Eine unerschöpfliche Quelle - geschlossene Dateien auslesen. Hier eine Frage aus Office-Loesung. Aus Tabellenblatt 1 sollen 4 Werte ausgelesen werden, aus Tabellenblatt 2 Werte aus Spalten, aber nur jede zweite. Zusätzlich ist auf Tabellenblatt 2 in Zelle E3 ein Datum. Es darf erst mit dem Auslesen ab dem Datum begonnen werden. Im ersten Code wird alles ausgelesen, im zweiten Code ist die Datumsbedingung mit eingearbeitet. Bitte erst die ReadMe.txt im Download lesen!

Geschlossene Dateien - Datum - Bedingung mit Beispieldateien...[ZIP, 160 KB]

' Code gehört in Modul1

Option Explicit
' Die Tabelle wird ausgelesen
Const strSheetQ1 AsString="Tabelle1"
' Die Tabelle wird ausgelesen
Const strSheetQ2 AsString="Tabelle2"
' Die Tabelle in dieser Datei
Const strSheetZ AsString="Gesamt"
' Die Zelle wird ausgelesen
Const strCellQ1 AsString="C"
' Die Zeile in Tabelle2 wird ausgelesen
Const lngRow AsLong=10
PublicSub Files_Read()
Dim strListing AsStr…

UserForm - Suchen - Ändern - Neu anlegen!

Frage aus dem Herber-Forum: Über eine UserForm soll in einem Tabellenblatt in Spalte A der in einer TextBox1 eingegebene Wert gesucht werden. Wird er gefunden soll in TextBox2 der korrespondierende Wert aus Spalte B angezeigt werden. Änderungen können nun vorgenommen und anschließend in das Tabellenblatt an die entsprechende Stelle zurück gespeichert werden. Ist der Wert nicht vorhanden, soll er am Ende neu angelegt werden.

UserForm - Suchen - Ändern - Neu anlegen...[ZIP, 60 KB]

' Code gehört in UserForm1

Option Explicit
PrivateSub TextBox1_Change()
Dim varTMP AsVariant
With Tabelle2
varTMP = Application.Match(TextBox1.Text,.Range("A:A"),0)
IfNotIsError(varTMP)Then
Me.Tag = varTMP
TextBox2.Text =.Cells(varTMP,2).Value
Else
Me.Tag =""
TextBox2.Text =""
EndIf
EndWith
EndSub
PrivateSub CommandButton1_Click()
Dim lngRow AsLong
IfTrim(TextBox1.Text)<>"" And Trim(TextBox2.Text)<>""Then
IfMe.Tag <>"&q…

API - Timer - Tabellenblattschutz prüfen!

Frage aus Office-Loesung: Kann man das Setzen bzw. Aufheben des Tabellenblattschutzes überwachen? Ja - das geht per API. Wird der Tabellenblattschutz aufgehoben, dann wird der CommandButton ROT, sonst Grün.

API - Timer - Tabellenblattschutz prüfen...[ZIP, 50 KB]

Hinweise:
API - Set Timer

API - Kill Timer

Option Explicit
Private Declare Function KillTimer Lib "user32.dll"_
(ByVal hWnd AsLong,ByVal nIDEvent AsLong)AsLong
Private Declare Function SetTimer Lib "user32.dll"_
(ByVal hWnd AsLong,ByVal nIDEvent AsLong,_
ByVal uElapse AsLong,ByVal lpTimerFunc AsLong)AsLong
Public lngTimer AsLong
Sub SchutzAktiv(ByVal hWnd AsLong,ByVal lngMsg AsLong,_
ByVal lngEla AsLong,ByVal lngFunc AsLong)
If lngMsg =&H113Then
With Tabelle1
.CommandButton1.BackColor =IIf(Not.ProtectContents,&HFF&,&HC000&)
EndWith
EndIf
EndSub
Sub StartT()
lngTimer = SetTimer(0,0,300, AddressOf SchutzAktiv)
EndSub
Sub StopT()
KillTimer 0, lngTimer
EndSub

UserForm - Zahlen - Komma -Tabellenblatt!

Frage: Wie kann man über eine UserForm Zahlen und Komma in Zellen eingeben? Die Windowsinterne Bildschirmtastatur (OSK) soll nicht verwendet werden. So:

UserForm - Zahlen - Komma -Tabellenblatt...[ZIP, 60 KB]

'Code in "DieseArbeitsmappe":

Option Explicit
PrivateSub Workbook_Open()
UserForm1.Show 0
EndSub
PrivateSub Workbook_BeforeClose(Cancel AsBoolean)
Call Terminate_Class
EndSub

'Code in ein Modul:

Option Explicit
Private objButton()As clsButton
PublicSub Terminate_Class()
Dim lngIndex AsLong
IfIsArray(objButton)Then
For lngIndex =LBound(objButton)ToUBound(objButton)
Set objButton(lngIndex)=Nothing
Next
EndIf
Erase objButton
EndSub

'Code in "UserForm1":

Option Explicit
Private objButton()As clsButton
PrivateSub UserForm_Activate()
Dim objControl As Control
Dim lngCounter AsLong
ForEach objControl In Controls
If TypeOf objControl Is MSForms.CommandButton Then
ReDim Preserve objButton(0To lngCounter)
Set objButton(lngCounter)=New clsButton
Set objButton(lngCounter).SetButton = obj…

Worddateien durchsuchen - auch mit Passwort!

Einen älteren Blogeintrag etwas angepasst. In Worddateien - optional auch in Unterordnern - soll ein bestimmter Begriff gesucht werden. Wird der Begriff im Worddokument gefunden, soll das Dokument aufgelistet und mit einem Hyperlink versehen werden. Die Worddokumente können auch ein Kennwort haben, dass beim Öffnen verlangt wird.

Worddateien durchsuchen - auch mit Passwort...[ZIP, 280 KB]

Option Explicit
Private Declare Function GetCurrentDirectory Lib "kernel32"_
Alias "GetCurrentDirectoryA"_
(ByVal nBufferLength&,ByVal lpBuffer$)AsLong
Private Declare Function SetCurrentDirectory Lib "kernel32"_
Alias "SetCurrentDirectoryA"_
(ByVal lpPathName$)AsLong
Const strSearchTMP AsString="Calculation"
Const strEXT AsString="*.doc*"
Private strList()AsString
Private objWDApp AsObject
Private lngCount AsLong
Private objFSO AsObject
PublicSub Test()
Dim strListing AsString
Dim strDirOld AsString
lngCount =0
OnErrorGoTo Fin
strDirOld$ =S…