Posts

Es werden Posts vom Juni, 2011 angezeigt.

Geschlossene Dateien - ADO - Tabellenblatt!

Frage: Der Tabellenblattname kann nicht genau festgelegt werden. Es können zwei verschiedene Namen sein. Dies geht aber nicht, wenn quasi geschlossene Dateien per Formel ausgelesen werden. Hier wird per ADO geprüft, welches Tabellenblatt in der Datei ist.

Geschlossene Dateien - ADO - Tabellenblatt...[ZIP, 140 KB]

Option Explicit
Const strSheetZ AsString="Tabelle1"' Die Tabelle in dieser Datei
Const strCellQ1 AsString="L8"' Die Zelle wird ausgelesen
Const strCellQ2 AsString="L6"' Die Zelle wird ausgelesen
PublicSub Files_Read()
Dim stCalc AsInteger
Dim strDir AsString
Dim objFSO AsObject
Dim objDir AsObject
OnErrorGoTo Fin
With Application
.ScreenUpdating =False
.AskToUpdateLinks =False
.EnableEvents =False
stCalc =.Calculation
.Calculation = xlCalculationManual
.DisplayAlerts =False
EndWith
' Wenn der Inhalt vorher gelöscht werden soll
' ThisWorkbook.Worksheets(strSheetZ).Columns("A:C").ClearContents
Set objFSO =CreateObject("Scriptin…

Tabellenblätter Passwort einblenden/ausblenden!

Über eine Startseite sollen alle Tabellenblätter nur mit Passwort eingeblendet werden können. Diese sind in der Regel ausgeblendet "xlSheetVeryHidden". Auswahl über eine UserForm. Wird auf die Startseite zurückgegangen wird das entsprechende Tabellenblatt wieder ausgeblendet.

Tabellenblätter Passwort einblenden/ausblenden...[ZIP, 60 KB]

' Code in ein Modul
Option Explicit
OptionPrivateModule
Sub Alle_Ausblenden()
Dim wksSheet As Worksheet
ForEach wksSheet In ThisWorkbook.Worksheets
If wksSheet.Name<>"Start"Then
wksSheet.Visible = xlSheetVeryHidden
EndIf
Next wksSheet
EndSub
Sub UF_Show()
UserForm1.Show
EndSub

' Code in UserForm1
Option Explicit
PrivateSub UserForm_Activate()
Dim wksSheet As Worksheet
ForEach wksSheet In ThisWorkbook.Worksheets
If wksSheet.Name<>"Start" And wksSheet.Name<>"Pass"Then
ComboBox1.AddItem (wksSheet.Name)
EndIf
Next wksSheet
ComboBox1.ListIndex =0
With TextBox1
.Text =""
.Passwor…

Formeln - Werte - Speichern ohne Makros!

Achtung - funktioniert nur in Excel 2007 bzw. 2010. Wenn man in Excel 2007/2010 eine XLSM-Datei mit Makros OHNE Makros speichern möchte, kann man diese Datei einfach als XLSX speichern und die Makros sind alle weg. Ein Button im Tabellenblatt (aus Formularsteuerelemente) löscht sich beim Klick durch "Application.Caller" von selber. Formeln werden durch die Werte ersetzt. Noch andere vorhandene Tabellenblätter werden gelöscht und die Datei dann mit "SaveAs" als XLSX gespeichert. Die Ursprungsdatei bleibt bestehen.

Formeln - Werte - Speichern ohne Makros...[ZIP, 50 KB]

Option Explicit
Const strFileName AsString="Dateiname"
PrivateSub Test()
Dim wksSheet As Worksheet
Dim varPath AsVariant
OnErrorGoTo Fin
Application.DisplayAlerts =False
varPath = Application.GetSaveAsFilename(_
InitialFileName:=ThisWorkbook.Path &"\"& strFileName,_
FileFilter:="Excel(*.xlsx), *.xlsx",_
Title:="Speichern ohne Makros")
I…

Ausgeblendete Tabellenblätter Inhalt anzeigen!

Es soll nur ein Tabellenblatt sichtbar sein. Alle restlichen Sheets sind per "xlSheetVeryHidden" ausgeblendet. In einer ComboBox auf dem ersten Tabellenblatt können die Tabellenblätter ausgewählt und der Inhalt angezeigt werden.

Ausgeblendete Tabellenblätter Inhalt anzeigen...[ZIP, 70 KB]

Option Explicit
PrivateSub Workbook_Open()
Dim intTMP AsInteger
OnErrorGoTo Fin
With Tabelle1
.ComboBox1.Clear
.ComboBox1.AddItem ("Auswahl...")
For intTMP =1To ThisWorkbook.Worksheets.Count
If ThisWorkbook.Worksheets(intTMP).Index >1Then
.ComboBox1.AddItem _
(ThisWorkbook.Worksheets(intTMP).Name)
EndIf
Next intTMP
.ComboBox1.ListIndex =0
EndWith
Fin:
IfErr.Number <>0ThenMsgBox"Fehler: "&_
Err.Number &" "&Err.Description
EndSub
PrivateSub Workbook_BeforeClose(Cancel AsBoolean)
Dim wksSheet As Worksheet
ForEach wksSheet In ThisWorkbook.Worksheets
If wksSheet.Index >1Then_
wksSheet.Visible = xlSheetVeryHidden
Next wksSheet
EndSub

Daten Spalte B jeweils in neue Dateien aufteilen!

Frage aus Office-Loesung: Werte aus Spalte B die jeweils ein- oder auch mehrmals unsortiert vorliegen, sollen in neue Dateien abgespeichert werden. Im folgenden Beispiel von Spalte A bis Spalte D. Gelöst über temporäre Tabellenblätter und den Spezialfilter. Eventuell vorhandene Dateien mit gleichem Namen werden ohne Nachfrage überschrieben.

Daten Spalte B jeweils in neue Dateien aufteilen...[ZIP, 50 KB]

Option Explicit
PublicSub Aufteilen()
Dim wksKriterienSheet As Worksheet
Dim wksQuellSheet As Worksheet
Dim rngKriterium As Range
Dim wksNew As Worksheet
Dim wkbBook As Workbook
Dim lngLastRow AsLong
OnErrorGoTo Fin
With Application
.ScreenUpdating =False
.DisplayAlerts =False
EndWith
' Tabellenblatt mit Daten - Name ANPASSEN
Set wksQuellSheet = Worksheets("Gesamt")
Set wksKriterienSheet = Worksheets.Add
wksKriterienSheet.Move After:=_
ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
lngLastRow = wksQuellSheet.Range("B"& Rows.Count).End(xlUp).Row
wksQue…

Heutiges Datum - Spalte A - Finden - Markieren!

In Spalte A stehen die Tage des jeweiligen Jahres in der Form 01.01.2011 bis 31.12.2011. Es soll nun zum aktuellen Datum gesprungen werden. Dazu nutze ich die "FollowHyperlink-Prozedur" des Worksheetobjektes. Der Code gehört in den Codebereich des entsprechenden Tabellenblattes.

Heutiges Datum - Spalte A - Finden - Markieren...[ZIP, 50 KB]

Option Explicit
PrivateSub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Application.Goto Range("A:A").Find _
(Date, LookIn:=xlValues, LookAt:=xlPart),True
EndSub