Posts

Es werden Posts vom September, 2008 angezeigt.

Files and Folders!

So "Application.FileSearch" is under Excel 2007 not available the following is a possibility to listed files and folders. The codes differ only in the selection of the folder and whether an hyperlink is set or not. The files at the end of the article are Excelfiles of the version 2003 and 2007.
The following code belonged in "Module1"
Option Explicit
Private strList()AsString
Private lngCount AsLong
PublicSub Test()
lngCount =0
SearchFiles "C:\Temp","*.*"'adapt
If lngCount =0Then
MsgBox"No file found"
ExitSub
EndIf
With ThisWorkbook.Worksheets(1)
.Cells.Clear
.Range(.Cells(1,1), Cells(lngCount,1))=_
WorksheetFunction.Transpose(strList)
EndWith
EndSub
PrivateSub SearchFiles(strFolder AsString, strFileName AsString)
Dim objFolder AsObject
Dim objFile AsObject
Dim objFSO AsObject
Set objFSO =CreateObject("Scripting.FileSystemObject")
ForEach objFile In objFSO.GetFolder(strFolder).Files
If objFile.Name Like strFileName Then
Redi…

Information about Shapes!

In the following code different information about Shapes on the current worksheet is spent. If you need still more information, then you look with F2 into the object catalog or also in the "Local Window", if you go with F8 step by step through the code. The files at the end of the article are Excelfiles of the version 2003 and 2007.
The following code belonged In "Module1"

Option Explicit
PublicSub Shape_Info()
Dim wksSheetNew As Worksheet
Dim wksSheet As Worksheet
Dim wksTMP As Worksheet
Dim shpShape As Shape
Dim lngRow AsLong
OnErrorGoTo Fin
Application.ScreenUpdating =False
ForEach wksTMP In ThisWorkbook.Worksheets
If wksTMP.Name="Info_Shapes"Then
Application.DisplayAlerts =False
wksTMP.Delete
Application.DisplayAlerts =True
EndIf
Next wksTMP
Set wksSheet = ActiveSheet
If wksSheet.Shapes.Count <1Then
MsgBox"No Shapes in the current worksheet!"
ExitSub
EndIf
Set wksSheetNew = Worksheets.Add(Before:=Worksheets(1))
wksShee…

Text largely or small!

Over a selection (UserForm) it is selected whether with an existing text all characters are represented largely or small. Or only the first character are largely represented. A further possibility offers the selection to write each individual alphabetic character after a dot largely. The files at the end of the article are Excelfiles of the version 2003 and 2007.
The following code belonged In "UserForm1"

Option Explicit
PrivateSub Image1_Click()
Me.OptionButton1.Value =False
Me.OptionButton2.Value =False
Me.OptionButton3.Value =False
Unload UserForm1
EndSub
PrivateSub Image2_Click()
IfMe.OptionButton1.Value =TrueThen
Me.OptionButton1.Tag ="Go"
ElseIfMe.OptionButton2.Value =TrueThen
Me.OptionButton2.Tag ="Go"
ElseIfMe.OptionButton3.Value =TrueThen
Me.OptionButton3.Tag ="Go"
ElseIfMe.OptionButton4.Value =TrueThen
Me.OptionButton4.Tag ="Go"
EndIf
Me.Hide
EndSub
PrivateSub UserForm_Activate()
Me.OptionButton1.Value =True
EndSub
PrivateSub UserForm_QueryClose…

Mark cells with formula!

Marked or all cells with formulas are represented with a red frame. The formulas are written additionally into the comment of the respective cell. Repeat the code deletes the frame and the comment. By the line "Option Private Module" the macros are not indicated in the macro window, but can be assigned however over the name to a button. The files at the end of the article are Excelfiles of the version 2003 and 2007.
The following code belonged In "Module1"

Option Explicit
OptionPrivateModule
PublicSub Formula_Frame_Comment()
Dim rngRange As Range
Dim strTMP AsString
OnErrorGoTo Fin
Application.ScreenUpdating =False
If Selection.Count >1Then
strTMP = Selection.Address(False,False)
Else
strTMP = Range(Cells(1,1),_
Cells(Last_R, Last_C)).Address(False,False)
EndIf
ForEach rngRange In Range(strTMP)
With rngRange
If.HasFormula Then
If.Comment Is NothingThen
.Borders.LineStyle = xlDot
.Borders.Weight = xlThin
.Borders.ColorIndex =3
.AddComment (.Formula)
.Com…