28.04.2009

Sheet - Copy - Name - Loop - Examine!

A worksheet is copied and placed against the end. The name is entered over an input box. Different is examined: Name already available? Name valid? Name more largely 31 indications? In the second code the name in a loop is queried until a correct input was made. The files at the end of the article are Excelfiles of the version 2003 and 2007. The following code belonged in "Module1".


Ein Tabellenblatt wird kopiert und ans Ende gestellt. Der Name wird über eine Inputbox eingegeben. Verschiedenes wird geprüft: Name schon vorhanden? Name gültig? Name größer 31 Zeichen? Im zweiten Code wird der Name in einer Schleife abgefragt, bis eine richtige Eingabe gemacht wurde. Die Dateien am Ende des Artikels sind Exceldateien der Version 2003 und 2007. Der folgende Code gehört in "Modul1".


Option Explicit
Public Sub Test()
Dim strName As String
strName = InputBox("Name enter", "Input", "Tab22")
If strName = "" Then Exit Sub
If Not strName Like _
"*[\,/,<,>,|,*,?,:,;,+,#, ,,ä,ö,ü,ß,!]*" Then
If SheetExist(strName) = True Then
MsgBox "Tabellenblatt vorhanden!"
Else
If Not Len(strName) > 31 Then
ThisWorkbook.Worksheets("Main").Copy _
After:=ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = strName
Else
MsgBox "Sheet name > 31 indications!"
End If
End If
Else
MsgBox "Invalid name!"
End If
End Sub
Private Function SheetExist(strTMP As String) As Boolean
Dim wksSheet As Worksheet
For Each wksSheet In ThisWorkbook.Worksheets
If wksSheet.Name = strTMP Then SheetExist = True: Exit For
Next
End Function

The following code belonged In "Module2"

Der folgende Code gehört In "Modul2"

Option Explicit
Public Sub Test_1()
Dim blnTMP As Boolean
Dim strName As String
Do
strName = InputBox("Name enter", "Input", "Tab22")
If strName = "" Then Exit Sub
If Not strName Like _
"*[\,/,<,>,|,*,?,:,;,+,#, ,,ä,ö,ü,ß,!]*" Then
If SheetExist(strName) = True Then
MsgBox "Tabellenblatt vorhanden!"
Else
If Not Len(strName) > 31 Then
ThisWorkbook.Worksheets("Main").Copy _
After:=ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = strName
blnTMP = True
Else
MsgBox "Sheet name > 31 indications!"
End If
End If
Else
MsgBox "Invalid name!"
End If
Loop Until blnTMP = True
End Sub
Private Function SheetExist(strTMP As String) As Boolean
Dim wksSheet As Worksheet
For Each wksSheet In ThisWorkbook.Worksheets
If wksSheet.Name = strTMP Then SheetExist = True: Exit For
Next
End Function


Sample 2003

Sample 2007

27.04.2009

VB.NET - Cells Read Closed Files!


With this tool you can pick the content of a cell / several cells from all Excel files of a freely selectable folder into a summary file. With several cells the entries must be entered separately by a comma into the TextBox. The worksheets can be given either with their name or with the index. The summary file is stored in the determined temp folder and opened directly. With a double-click e.g. in Textbox1 the value "Sheet1" is inserted. Subfolders can be included also. The path and file name can be put in the comment of the respective cell. You must have installed the .NET Framework 3.5 on the computer.


Mit diesem Tool können Sie aus allen Exceldateien eines frei wählbaren Ordners den Inhalt einer Zelle / mehrerer Zellen in eine Gesamtdatei auslesen. Bei mehreren Zellen müssen die Einträge getrennt durch ein Komma in die TextBox eingegeben werden. Die Tabellenblätter können entweder mit ihrem Namen oder mit dem Index vorgegeben werden. Die Gesamtdatei wird im ermittelten TEMP-Ordner gespeichert und gleich geöffnet. Mit einem Doppelklick wird z. B. in Textbox1 der Standartwert "Sheet1" eingetragen. Unterordner können auch mit einbezogen werden. Der Pfad und Dateiname kann auch im Kommentar der jeweiligen Zelle abgelegt werden. Sie müssen das .NET Framework 3.5 auf ihrem Computer installiert haben.



MSI Setup

22.04.2009

VB.NET - Cell Read Closed Files!


With this tool you can pick the content of a cell from all Excel files of a freely selectable folder into a summary file. The worksheets can be given either with their name or with the index. The summary file is stored in the determined temp folder and opened directly. With a double-click e.g. in Textbox1 the value "Sheet1" is inserted. Subfolders can be included also. The path and file name can be put in the comment of the respective cell. You must have installed the .NET Framework on the computer.


Mit diesem Tool können Sie aus allen Exceldateien eines frei wählbaren Ordners den Inhalt einer Zelle in eine Gesamtdatei auslesen. Die Tabellenblätter können entweder mit ihrem Namen oder mit dem Index vorgegeben werden. Die Gesamtdatei wird im ermittelten TEMP-Ordner gespeichert und gleich geöffnet. Mit einem Doppelklick wird z. B. in Textbox1 der Standartwert "Sheet1" eingetragen. Unterordner können auch mit einbezogen werden. Der Pfad und Dateiname kann auch im Kommentar der jeweiligen Zelle abgelegt werden. Sie müssen das .NET Framework auf ihrem Computer installiert haben.



MSI Setup

20.04.2009

Code - Macro - Save!

The following code is a help, if you liked to save all macros of your unprotected files (optional with subfolders) in a text file. The files at the end of the article are Excelfiles of the version 2003 and 2007. The following code belonged in a "Module"


Der folgende Code hilft Ihnen, wenn Sie alle Makros ihrer ungeschützten Dateien (Optional mit Unterordnern) in einer Textdatei sichern möchten. Die Dateien am Ende des Artikels sind Exceldateien der Version 2003 und 2007. Der folgede Code gehört in ein "Modul."


Option Explicit
Private Declare Function GetCurrentDirectory Lib "kernel32" _
Alias "GetCurrentDirectoryA" _
(ByVal nBufferLength&, ByVal lpBuffer$) As Long
Private Declare Function SetCurrentDirectory Lib "kernel32" _
Alias "SetCurrentDirectoryA" (ByVal lpPathName$) As Long
Public lngCount As Long
' IMPORTANT
' Tools - References... Microsoft Scripting Runtime
' Extras - Verweise... Microsoft Scripting Runtime
Public Sub Code_Save()
Dim strDirOld As String
Dim strPath As String
Dim blnTMP As Boolean
On Error GoTo Code_Save_Error
strDirOld$ = String(255, 0)
Call GetCurrentDirectory(255, strDirOld$)
strDirOld$ = Left(strDirOld$, InStr(1, strDirOld$, vbNullChar) - 1)
lngCount = 0
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "Folder"
.ButtonName = "Select..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strPath = .SelectedItems(1)
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
Else
MsgBox "No Folder!"
Call SetCurrentDirectory(strDirOld$)
Exit Sub
End If
End With
Select Case MsgBox("Subfolders?", vbYesNo Or _
vbQuestion Or vbDefaultButton1, "Subfolders")
Case vbYes
blnTMP = True
Case vbNo
blnTMP = False
End Select
Application.ScreenUpdating = False
FileList strPath, blnTMP
MsgBox "Finished! " & lngCount & " files were read in!"
Call SetCurrentDirectory(strDirOld$)
Application.ScreenUpdating = True
On Error GoTo 0
Exit Sub
Code_Save_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
Call SetCurrentDirectory(strDirOld$)
Application.ScreenUpdating = True
End Sub
Public Sub FileList(ByVal strStartFolder As String, _
ByVal blnFolder As Boolean)
Dim objFSO As Scripting.FileSystemObject
Dim scrStartFolder As Scripting.Folder
Dim scrSubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim blnStatus As Boolean
Dim wkbBook As Workbook
Dim intFile As Integer
Dim objCodes As Object
Dim varItem As Variant
Dim lngRow As Long
On Error GoTo FileList_Error
Set objFSO = New Scripting.FileSystemObject
Set scrStartFolder = objFSO.GetFolder(strStartFolder)
blnStatus = Application.DisplayStatusBar
Application.DisplayStatusBar = True
For Each FileItem In scrStartFolder.Files
If FileItem.Name Like "*.xls" And _
Dir(FileItem.Name) <> ThisWorkbook.Name Then
Application.StatusBar = "Work on file: " & FileItem.Name & " ..."
lngCount = lngCount + 1
Set wkbBook = GetObject(strStartFolder & "\" & FileItem.Name)
intFile = FreeFile
Open ThisWorkbook.Path & "\" & Left(FileItem.Name, _
Len(FileItem.Name) - 4) & ".txt" For Output As #intFile
Print #intFile, "File name: " & FileItem.Name
Print #intFile, "Folder: " & strStartFolder
Print #intFile, "Created: " & Now
Print #intFile, String(32, "#")
Print #intFile, ""
Print #intFile, "File created: " & FileItem.DateCreated
Print #intFile, "Last access: " & FileItem.DateLastAccessed
Print #intFile, "Last change: " & FileItem.DateLastModified
Print #intFile, String(32, "#")
Print #intFile, ""
For Each objCodes In wkbBook.VBProject.VBComponents
Print #intFile, ""
With objCodes.CodeModule
Print #intFile, "'" & "Name: " & objCodes.Name
For lngRow = 1 To .CountOfLines
If Trim(.Lines(lngRow, 1)) <> "" Then
Print #intFile, .Lines(lngRow, 1)
End If
Next lngRow
End With
Next objCodes
Print #intFile, ""
Print #intFile, String(25, "#")
Print #intFile, ""
Print #intFile, "Verweise im Editor:"
Print #intFile, ""
Set objCodes = wkbBook.VBProject.References
For Each varItem In objCodes
Print #intFile, varItem.Description
Next varItem
wkbBook.Close False
Close intFile
End If
Next FileItem
If blnFolder Then
For Each scrSubFolder In scrStartFolder.SubFolders
FileList scrSubFolder.Path, True
Next scrSubFolder
End If
Set scrStartFolder = Nothing
Set objFSO = Nothing
Application.StatusBar = False
Application.DisplayStatusBar = blnStatus
On Error GoTo 0
Exit Sub
FileList_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
Application.StatusBar = False
Application.DisplayStatusBar = blnStatus
Set scrStartFolder = Nothing
Set objFSO = Nothing
End Sub


Sample 2003

Sample 2007

16.04.2009

UserForm - Control - Runtime!


In a UserForm controls like TextBox or ComboBox are provided at runtime. Due to the different macros (UserForm, Module, Class Module) there are only the files to download here. The topics are UserForm, controls, runtime, class module. In the last UserForm you are pointed to the possibility to print sheets over CheckBoxes. In labels the number of print pages is indicated. The files at the end of the article are Excelfiles of the version 2003 and 2007.


In einer UserForm werden zur Laufzeit TextBox und ComboBox hinzugefügt. Da die Makros in verschiedenen Bereichen sind, gibt es die Dateien nur zum downloaden. Die Themen sind UserForm, Steuerelemente, Laufzeit, Klassenmodule. In der letzten Userform wird die Möglichkeit aufgezeigt Tabellenblätter über Checkboxen zu drucken. In Labels wird die Anzahl der Druckseiten angezeigt. Die Dateien am Ende des Artikels sind Exceldateien der Version 2003 und 2007.



Sample 2003

Sample 2007

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 ...