Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
724to728
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
724to728
724to728
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Tabellenblatt speichern....
Joachim
Hallo,
ich möchte einen Bereich eines Tabellenblattes separat speichern, bei dem alle Formate identisch sind, jedoch keine Formeln enthalten sein sollen.
Mit Hilfe dieses Forums habe ich letztlich den folgenden Code eingebunden.
_____________________________________________

Sub Speichern_BeiKlick()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = Sheets.Add
ws.Name = "AUSWERTUNG"
Sheets("ANALYSE").Range("A1:O100").Copy
Sheets("Ergebnis").Range("A1").PasteSpecial Paste:=xlPasteValues
Sheets("Ergebnis").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
Sheets("Ergebnis").Range("A1").PasteSpecial Paste:=xlPasteFormats
ActiveSheet.Copy
Application.Dialogs(xlDialogSaveAs).Show "C:\"
ActiveWorkbook.Close
Application.DisplayAlerts = False
Sheets("Ergebnis").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

____________________________________
Das Resultat ist genauso, wie ich es haben möchte, nur...
Es werden nicht die Formate der ZeilenHÖHE richtig übertragen.
Was kann man da machen?
Gruß
Jo

50
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Tabellenblatt speichern....
Josef
Hallo Joachim!
Versuch's mal so!
Sub Speichern_BeiKlick()
Dim objWb As Workbook
Dim rng As Range

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .DisplayAlerts = False
  .Calculation = xlCalculationManual
End With

Sheets("ANALYSE").Copy

Set objWb = ActiveWorkbook

With objWb
  .Sheets(1).Name = "Ergebnis"
  On Error Resume Next
  For Each rng In .Sheets(1).Cells.SpecialCells(xlCellTypeFormulas, 23)
    rng = rng.Value
  Next
  Err.Clear
  On Error GoTo ErrExit
  Application.Dialogs(xlDialogSaveAs).Show "C:\"
  .Close
End With

ErrExit:

Set objWb = Nothing

If Err.Number > 0 Then
  MsgBox Err.Number & vbLf & Err.Description, , "Fehler"
  Err.Clear
End If

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .DisplayAlerts = True
  .Calculation = xlCalculationAutomatic
End With

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Tabellenblatt speichern....
Joachim
Hallo "Sepp",
vielen Dank - in dieser Ecke war ich schon mal so ungefähr, doch...
Das Problem ist:
1.) in Tabellenblatt 1 (Analyse) ist ein Makro enthalten - das darf nicht mit kopiert werden.
2.) es soll nur der Bereich A1-O100 kopiert werden.
ansonsten ist es so wie ich es mir vorstelle.
(Sogar noch besser - da auch die Ansicht die ich mit dem Makro -Leere Zeilen ein-/ausblenden mache genau übertragen wird. Also mit oder ohne den leeren Zellen, ganz wie meine letzte Ansicht in der Originaltabelle war. TOP !)
Ich hoffe, das kriegen wir auch noch hin.
Gruß
Jo.
Anzeige
AW: Tabellenblatt speichern....
Josef
Hallo Joachim!
Dann so!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Speichern_BeiKlick()
Dim objWb As Workbook
Dim rng As Range

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .DisplayAlerts = False
  .Calculation = xlCalculationManual
End With

Sheets("ANALYSE").Copy

Set objWb = ActiveWorkbook

With objWb
  .Sheets(1).Name = "Ergebnis"
  On Error Resume Next
  For Each rng In .Sheets(1).Cells.SpecialCells(xlCellTypeFormulas, 23)
    rng = rng.Value
  Next
  Err.Clear
  On Error GoTo ErrExit
  .Sheets(1).Range("P1:IV65536").Delete
  .Sheets(1).Range("A101:IV65536").Delete
  With .VBProject.VBComponents(.Sheets(1).CodeName).CodeModule
    .DeleteLines 1, .CountOfLines
  End With
  Application.Dialogs(xlDialogSaveAs).Show "C:\"
  .Close
End With

ErrExit:

Set objWb = Nothing

If Err.Number > 0 Then
  MsgBox Err.Number & vbLf & Err.Description, , "Fehler"
  Err.Clear
End If

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .DisplayAlerts = True
  .Calculation = xlCalculationAutomatic
End With

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Tabellenblatt speichern....
Joachim
Hi,
irgendetwas ist (noch) nicht OK.
Wenn ich das Makro einbinde und dann starte kommt Fehlermeldung: 1004
Wenn dann das zweite mal starte, Kommt Fehler 9
Ausserdem wird das Makro im Blatt 1 nicht entfernt.
Die Speicheroption wird nicht aufgerufen.
Trotz Fehlermeldung wird MAPPE(x).xls gespeichert und nach dem Start wird das Optionsfenster - Makros aktivieren/deaktivieren angezeigt.
Es soll der Speichern unter... Dialog gestartet werden
Die -Ausgabetabelle (Mappe) - soll nichts an Makros enthalten und an Formeln gespeichert werden.
Gruß
Jo
Blattschutz!
Josef
Hallo Joachim!
Deine Tabelle ist geschützt!
Achte auf die Kommentare im Code!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Speichern_BeiKlick()
Dim objWb As Workbook
Dim rng As Range

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .DisplayAlerts = False
  .Calculation = xlCalculationManual
End With

Sheets("ANALYSE").Copy

Set objWb = ActiveWorkbook

With objWb
  .Sheets(1).Name = "Ergebnis"
  .Sheets(1).Unprotect "deinPasswort" ' wenn ohne Passwort geschützt, dann .Sheets(1).Unprotect !
  On Error Resume Next
  For Each rng In .Sheets(1).Cells.SpecialCells(xlCellTypeFormulas, 23)
    rng = rng.Value
  Next
  Err.Clear
  On Error GoTo ErrExit
  .Sheets(1).Range("P1:IV65536").Delete
  .Sheets(1).Range("A101:IV65536").Delete
  With .VBProject.VBComponents(.Sheets(1).CodeName).CodeModule
    .DeleteLines 1, .CountOfLines
  End With
  .Sheets(1).Protect "deinPasswort" ' wenn ohne Passwort geschützt, dann .Sheets(1).Protect !
  Application.Dialogs(xlDialogSaveAs).Show "C:\"
  .Close
End With

ErrExit:

Set objWb = Nothing

If Err.Number > 0 Then
  MsgBox Err.Number & vbLf & Err.Description, , "Fehler"
  Err.Clear
End If

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .DisplayAlerts = True
  .Calculation = xlCalculationAutomatic
End With

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Blattschutz!
Joachim
Hallo Sepp,
nun habe ich wieder etwas anderes.Nach dem ich dein Makros abgändert habe folgt nun der Fehler:
1004 Der programmatische auf das VBA-Projekt.......
ausserdem ist der Code auch immer noch in dieser Tabelle.
Gruß
JO
AW: Blattschutz!
Josef
Hallo Joachim!
Du musst unter "Extras" &gt "Makro" &gt "Sicherheit", den Zugriff auf das VBA-Projekt zulassen!
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Blattschutz!
Joachim
Hallo Sepp,
soweit so gut, aber nun steht immer noch Code in dem gespeicherten Blatt.
z.B.

Private Sub Workbook_Open()
End Sub

ohne weitere Inhalte.
Kann man dies auch noch eliminieren?
Es wird beim Öffnen des gespeicherten Blattes immer noch nach den Makros gefragt.
Ausserdem ist auch noch der Button -Leere Zeilen...- auf dem gespicherten Tabellenblatt
dieser befindet sich iauf den Zellen P6 und P7. Ich habe diesen Umstand auf dem beigefügten Bild festgehalten.
Userbild
Dann wäre es noch schön, wenn beim speichern des Einzelblattes als Dateinamevorschlag
-Ergebnis+(zelle e1).xls- gemacht werden würde.
- Dies ist allerdings nur ein Komfortzusatz und nur nötig, wenn der Aufwand zur Programmierung einfach ist - Also nicht unbedingt zuviel Arbeit damit machen.-
Dies hätte aber zur Folge, dass ich eine Zwangseintragung in Zelle E1 machen muss.
Heisst also ich kann nur exportieren/Blatt speichern unter, wenn ein Eintrag in Zelle E1 gemacht wurde. Bekomme ich diese Zwangseintragung mit der Gültigkeitsprüfung hin?
Mir fehlt der Ansatz des Eintrages hier.
Gruß
Jo
Anzeige
AW: Blattschutz!
Josef
Hallo Joachim!
Es wäre wesentlich einfacher, wenn du die Infos zu beginn deiner Frage geben würdest!
Leider habe ich zu Weihnachten keine neue Glaskugel bekommen, und die Alte ist schon
ein wenig trüb;-)
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit


Sub Speichern_BeiKlick()
Dim objWb As Workbook
Dim objVBComp As Object
Dim objShape As Shape
Dim strFileName As String
Dim rng As Range

strFileName = Trim$(Sheets("ANALYSE").Range("E1"))

If strFileName = "" Then
  MsgBox "Bitte Eintrag in Zelle [E1] vornehmen!" & Space(20) & vbLf & _
    "Der Vorgang wird abgebrochen!", 64, "Hinweis"
  Exit Sub
End If

strFileName = strFileName & ".xls"

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .DisplayAlerts = False
  .Calculation = xlCalculationManual
End With

Sheets("ANALYSE").Copy

Set objWb = ActiveWorkbook

With objWb
  .Sheets(1).Name = "Ergebnis"
  .Sheets(1).Unprotect "deinPasswort" ' wenn ohne Passwort geschützt, dann .Sheets(1).Unprotect !
  On Error Resume Next
  For Each rng In .Sheets(1).Cells.SpecialCells(xlCellTypeFormulas, 23)
    rng = rng.Value
  Next
  Err.Clear
  On Error GoTo ErrExit
  .Sheets(1).Range("P1:IV65536").Delete
  .Sheets(1).Range("A101:IV65536").Delete
  
  For Each objVBComp In .VBProject.VBComponents
    With objVBComp.CodeModule
      .DeleteLines 1, .CountOfLines
    End With
  Next
  
  For Each objShape In .Sheets(1).Shapes
    objShape.Delete
  Next
  
  .Sheets(1).Protect "deinPasswort" ' wenn ohne Passwort geschützt, dann .Sheets(1).Protect !
  Application.Dialogs(xlDialogSaveAs).Show "C:\" & "Ergebnis " & strFileName
  .Close
End With

ErrExit:

Set objWb = Nothing

If Err.Number > 0 Then
  MsgBox Err.Number & vbLf & Err.Description, , "Fehler"
  Err.Clear
End If

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .DisplayAlerts = True
  .Calculation = xlCalculationAutomatic
End With

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Blattschutz!
Joachim
Hallo,
jaja die Weihnachtskugel - du hast eine neue verdient - Sorry aber manchmal übersieht man doch so einiges - werde mich bessern...
Also nun sind wir ganz nah am Ziel.
Funktion soweit ich sehe OK - nur die Makroabfrage wird immer noch gestellt.
Habe nach suchen noch diese Einträge gefunden:
VBA-Projekt
---------------------------
Arbeitsmappe:

Private Sub Workbook_Open()
End Sub

-------------------------------
tabelle1 (Ergebnis):

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub

----------------------------------
Darüberhinaus habe ich ja in der -Ursprungstabelle- noch div. Gültigkeitsregeln.
Diese sollten möglich auch nicht übertragen werden.
Kann man das ebenfalls unterbinden?
-----------------------------------
Wenn ich jetzt die gespeicherte Tabelle öffne und in eine -im Original- geschütze Zelle komme, wird das Passwort abgefragt.
Der Blattschutz müsste erst nachdem die Tabelle (Ergebnis) gespeichert wurde wieder in der (Ursprungs-Tabelle) gesetzt werden.
Das Passwort muss natürlich in der Ausgangstabelle vorhanden sein - in der gespeicherten -Ergebnistabelle- soll keine Passwortabfrage mehr sein. Alle Zellen sind editibar. Nur Rechnen kann man nicht damit, weil keine Formeln und keine Makros mehr dabei sind.
Gruß
Jo
Anzeige
AW: Blattschutz!
Josef
Hallo Joachim!
Gültigkeiten werden jetzt auch gelöscht! Ebenso Namen und Bedingte Formatierung.
Das mit dem Code, kann ich nicht nachvollziehen! bei mir wird alles entfernt.
Speziell der Code in "DieseArbeitsmappe", ist ein Rätsel, weil es sich um eine
neue Mappe handelt, darum ist dieses Modul normalerweise leer!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Speichern_BeiKlick()
Dim objWb As Workbook
Dim objVBComp As Object
Dim objShape As Shape
Dim objName As Name
Dim strFileName As String
Dim rng As Range

strFileName = Trim$(Sheets("ANALYSE").Range("E1"))

If strFileName = "" Then
  MsgBox "Bitte Eintrag in Zelle [E1] vornehmen!" & Space(20) & vbLf & _
    "Der Vorgang wird abgebrochen!", 64, "Hinweis"
  Exit Sub
End If

strFileName = strFileName & ".xls"

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .DisplayAlerts = False
  .Calculation = xlCalculationManual
End With

Sheets("ANALYSE").Copy

Set objWb = ActiveWorkbook

With objWb
  .Sheets(1).Name = "Ergebnis"
  .Sheets(1).Unprotect "deinPasswort" ' wenn ohne Passwort geschützt, dann .Sheets(1).Unprotect !
  On Error Resume Next
  
  For Each rng In .Sheets(1).Cells.SpecialCells(xlCellTypeFormulas, 23) 'Formel in Werte
    rng = rng.Value
  Next
  
  For Each rng In .Sheets(1).Cells.SpecialCells(xlCellTypeAllFormatConditions) 'Bedingte Formatierung entfernen
    rng.FormatConditions(1).Delete
    rng.FormatConditions(2).Delete
    rng.FormatConditions(3).Delete
  Next
  
  .Sheets(1).Cells.SpecialCells(xlCellTypeAllValidation).Validation.Delete 'Gültigkeiten entfernen
  
  Err.Clear
  On Error GoTo ErrExit
  .Sheets(1).Range("P1:IV65536").Delete
  .Sheets(1).Range("A101:IV65536").Delete
  
  For Each objName In .Names 'Definierte Namen entfernen
    objName.Delete
  Next
  
  For Each objVBComp In .VBProject.VBComponents 'VBA-Code entfernen
    With objVBComp.CodeModule
      .DeleteLines 1, .CountOfLines
    End With
  Next
  
  For Each objShape In .Sheets(1).Shapes 'Schaltflächen/Shapes entfernen
    objShape.Delete
  Next
  
  Application.Dialogs(xlDialogSaveAs).Show "C:\" & "Ergebnis " & strFileName
  .Close
End With

ErrExit:

Set objWb = Nothing

If Err.Number > 0 Then
  MsgBox Err.Number & vbLf & Err.Description, , "Fehler"
  Err.Clear
End If

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .DisplayAlerts = True
  .Calculation = xlCalculationAutomatic
End With

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Blattschutz!
Joachim
Hallo Sepp,
also ich habe jetzt nochmal den Code der einzelen Blätter geprüft.
Vor Ausführen deines Codes - ist auch der Code in der ursprünglichen Tabelle (ANALYSE):
(Dieser Code bewirkt eine Hintergrundfarbe der aktiven Zelle, die bewirkt das die aktive Zelle jederzeit sichtbar ist und nicht -gerade bei TFT-Monitoren- dauernd gesucht werden muss.)
------------------------

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
ActiveSheet.Unprotect ("abc")
Static Zelle As Range
If Not Zelle Is Nothing Then
Cells.Interior.ColorIndex = xlColorIndexNone
End If
Target.Interior.ColorIndex = 6 ' Gelb
Set Zelle = Target
ActiveSheet.Protect ("abc")
End Sub

-------------------------
vorhanden.
Nach Ausführen deines Codes in Modul2 und die dadurch vorgenommene Speicherung der Ergebnistabelle, befindet sich als Code an der selben Stelle nun noch:
-----------------

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub

--------------------
als Eintrag.
_______________________________________________________
Bei der Arbeitsmappe ist vor Ausführen Deines Codes auch dieser Code in der Arbeitsmappe:
(Dieser Code bewirkt nur eine Bindung des Tabellenblattes an den Rechner, damit nicht wahllos Kopien auf anderen Rechner abgelegt werden. Der Nutzer hat nur wenige Tage zur erstmaligen Nutzung der Tabelle - ebenso werden -Reservekopien- nach Ablauf der Lizensierungszeit unbrauchbar.)
--------------------

Private Sub Workbook_Open()
Dim sh As Worksheet
Dim ok As Boolean
Dim Meldung As String
ThisWorkbook.IsAddin = True
'Lizenz prüfen:
ok = False
If SerienNr_Blatt = "" Then
'noch nicht lizensiert:
If Datum_Blatt = "" Then Set_Datum_Blatt Date
If Date > CDate(Datum_Blatt) Then
'zu spät!
Meldung = "Die Lizensierungsmöglichkeit ist abgelaufen!" & vbLf & _
"Bitte wenden Sie sich an .........."
Else
'Tabelle lizensieren
Set_SerienNr_Blatt SerienNummer
Set_Datum_Blatt FormatDateTime(Date, vbShortDate)
Application.EnableEvents = False
ThisWorkbook.Save
Application.EnableEvents = True
ok = True
Meldung = "Die Tabelle wurde soeben für Ihren Rechner lizensiert." & vbLf & _
"Viel Spaß!"
End If
Else
'schon lizensiert:
If SerienNr_Blatt <> SerienNummer Then
'falsche Festplatten-ID
Meldung = "Die Tabelle wurde für auf einem anderen PC lizensiert." & vbLf & _
"Vielleicht haben Sie auch die Festplatte gewechselt." & vbLf & vbLf & _
"Bitte wenden Sie sich an ......."
Else
ok = True
End If
End If
'If Not ok Then ActiveWindow.Visible = False
If Meldung <> "" Then
Application.EnableCancelKey = xlDisabled
MsgBox Meldung
Application.EnableCancelKey = xlInterrupt
End If
ThisWorkbook.IsAddin = False
If Not ok Then
ThisWorkbook.Close False
Exit Sub
End If
'Alle Blätter einblenden
For Each sh In Worksheets
If sh.Name <> MakroBlatt Then
sh.Visible = True
End If
Next sh
'Infoblatt ausblenden
Sheets(MakroBlatt).Visible = xlSheetVeryHidden
ThisWorkbook.Saved = True
End Sub

----------------------------------
Nach Ausführen des Speicherns befindet sich in der gespeicherten Arbeitsmappe (Ergebnis)noch folgendes an der selben Stelle:
------------------

Private Sub Workbook_Open()
End Sub

-------------------
Eventuell muss man diese Einträge separat löschen um die Nachricht:
Makro deaktivieren/aktivieren
zu vermeiden.
Ich hoffe du kannst auch diese Lösung hierfür noch finden.
Wenn diese beiden Einträge eleminiert sind läuft die Tabelle: NameERGEBNIS.xls- in der richtigen Art.
Gruß
Joachim
AW: Blattschutz!
Detlef
Hi,
du beschäftigst schon seit Tagen das Forum mit einem Problem, dass sich mit VBA-Mitteln allein definitiv nicht lösen lässt.
mfg Detlef
@Detlef!
Josef
Hallo Detlef!
Das Problem über das Joachim und mich beschäftigt, hatt nichts mit dem Schutz,
bzw. der Nutzungsberechtigung der Datei zu tun!
Ausserdem solltest du und andere es den jeweilig beteiligten überlassen, ob und
wie lange sie über ein Problem diskutieren!
Gruß Sepp
AW: @Detlef!
Detlef
Hi,
ich bin nicht deiner Meinung, gebe aber aufgrund meiner Achtung vor deiner großen Kompetenz auf.
mfg Detlef
AW: Blattschutz!
Joachim
Hallo,
1.) bin ich ein Fan von Foren.
2.) bin auch in anderen Bereichen in Foren -da dann auch auf der anderen kompetenten Seite-
3.) man lernt nie aus
4.) man soll nie nie sagen ---- Du bist übrigens der erste, der dies zu mir sagt.
5.) in den guten Foren -und das hier ist eines der allerbesten- spricht man -teutlich-
alles ist freiwillig. Wenn einer keine Lust mehr hat lässt er eseinfach - und... niemand ist böse.
6.) jeder lernt von jedem - und das schöne an Foren ich kann mir aussuchen von wem ich was lerne - und niemand braucht einen Polizisten für seine Entscheidungen, was ihm Spaß macht und wozu er Lust hat.
7.) Den Hartnäckigen gehört die Welt und wer Lösungsorientiert denkt und handelt kommt immer an ein interessantes Ziel.
------
Das Problem - wie du es nennts - ist eigentlich nichts anderes als eine Herausforderung.
Was eine Herausforderung ist - ist für jeden sehr individuell und jeder hat eine andere Betrachtung.
Ürigens - das PROBLEM wurde mit VBA-Mitteln gelöst.
Somit haben wir alle etwas gelernt...
Musste ich einfach loswerden...
Ich ziehe jedenfalls den Hut vor Kompetenz und vor allem vor Menschen denen es Spass macht ihr Wissen anderen mitzuteilen = also zu teilen.
Doch mit Teilen hat so mancher heutzutage so seine Schwierigkeiten.
Wer's nicht mag kann sein Wissen mit ins Grab nehmen - nur da nutzt es, glaube ich niemandem mehr - Wozu hat man es sich denn dann angeeignet?
Wenn Einstein auch so gedacht hätte......
Gruß
Joachim
AW: Blattschutz!
Josef
Hallo Joachim!
Ich kann das mit dem Code nicht nachvollziehen!
Bei mir wird alles gelöscht!
Versuch's so nochmal, sonst hab eich keine weiteren Ideen!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Speichern_BeiKlick()
Dim objWb As Workbook
Dim objVBComp As Object
Dim objShape As Shape
Dim objName As Name
Dim strFileName As String
Dim rng As Range

strFileName = Trim$(Sheets("ANALYSE").Range("E1"))

If strFileName = "" Then
  MsgBox "Bitte Eintrag in Zelle [E1] vornehmen!" & Space(20) & vbLf & _
    "Der Vorgang wird abgebrochen!", 64, "Hinweis"
  Exit Sub
End If

strFileName = strFileName & ".xls"

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .DisplayAlerts = False
  .Calculation = xlCalculationManual
End With

Sheets("ANALYSE").Copy

Set objWb = ActiveWorkbook

With objWb
  .Sheets(1).Name = "Ergebnis"
  .Sheets(1).Unprotect "abc" ' wenn ohne Passwort geschützt, dann .Sheets(1).Unprotect !
  On Error Resume Next
  
  For Each rng In .Sheets(1).Cells.SpecialCells(xlCellTypeFormulas, 23) 'Formel in Werte
    rng = rng.Value
  Next
  
  For Each rng In .Sheets(1).Cells.SpecialCells(xlCellTypeAllFormatConditions) 'Bedingte Formatierung entfernen
    rng.FormatConditions(1).Delete
    rng.FormatConditions(2).Delete
    rng.FormatConditions(3).Delete
  Next
  
  .Sheets(1).Cells.SpecialCells(xlCellTypeAllValidation).Validation.Delete 'Gültigkeiten entfernen
  
  Err.Clear
  On Error GoTo ErrExit
  .Sheets(1).Range("P1:IV65536").Delete
  .Sheets(1).Range("A101:IV65536").Delete
  .Sheets(1).Range("A1:O100").Interior.ColorIndex = xlNone
  
  For Each objName In .Names 'Definierte Namen entfernen
    objName.Delete
  Next
  
  For Each objVBComp In .VBProject.VBComponents 'VBA-Code entfernen
    With objVBComp.CodeModule
      .DeleteLines 1, .CountOfLines
    End With
  Next
  
  For Each objShape In .Sheets(1).Shapes 'Schaltflächen/Shapes entfernen
    objShape.Delete
  Next
  
  Application.Dialogs(xlDialogSaveAs).Show "C:\" & "Ergebnis " & strFileName
  strFileName = .FullName
  .Close True
  
End With

Set objWb = Workbooks.Open(strFileName)
With objWb
  For Each objVBComp In .VBProject.VBComponents 'VBA-Code entfernen
    With objVBComp.CodeModule
      .DeleteLines 1, .CountOfLines
    End With
  Next
  .Save
  .Close True
End With

ErrExit:

Set objWb = Nothing

If Err.Number > 0 Then
  MsgBox Err.Number & vbLf & Err.Description, , "Fehler"
  Err.Clear
End If

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .DisplayAlerts = True
  .Calculation = xlCalculationAutomatic
End With

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

AW: Blattschutz!
Joachim
Hallo lieber Sepp,
ich es ist geschafft...
Nun klappt es wohl.
Vielen lieben Dank für deine intensive Hilfe und die der vielen anderen natürlich auch.
Werde morgen alles nochmals durchchecken und hoffentlich NICHTS störendes finden.
-------------------------
Nach dieser Aktion habe ich bemerkt, welche enormen Möglichkeiten in der VBA Abteilung machbar sind.
Bisher habe ich mich ausschließlich um das REINE EXCEL gekümmert und fast alles damit erreichen können, aber VBA ----schon toll...
Wo finde ich am besten und praxisnah gute Einlaitung in dieses Gebiet? Das muss ich auch beherrschen lernen.
Viele Grüße aus Düsseldorf
Jaochim
AW: Blattschutz!
Joachim
Hallo Sepp,
sieht alles verdammt gut aus, scheint alles zu funktionieren. Nochmals DANKE.
--------------
Nun habe ich noch eine -hoffentlich kleine- Komfortidee.
Wenn ich das -ERGEBNIS- speichern möchte, wird mir ja als Speicherort = C:\ vorgeschlagen, bezw. das Verzeichnis, welches ich im Makro benenne.
Da nun jeder eine anderes Zielverzeichnis haben möchte und dieses nicht generell C:\ heissen wird - muss er sich vom Verzeicnis C:\ zu seinem Speicherort herunterklicken.
--------------------
Gruß
Joachim
Könnte man eine erweiterte Routine derart einbauen, dass bei der Ablage im -heruntergeklickten- verzeichnis, dieser Ort gemerkt wird und beim nächsten Mal direkt vorgeschlagen wird?
Ich stelle es mir so vor:
Das erste mal wird c:\ vorgeschlagen.
Ich wähle aber als Zielverzeichnis z.B. E:\Dokumente\Auswertungen\Ergebnisse\
dann kommt der Dateiname z.B. Ergebnis_Schulze Jürgen.xls
Wenn ich nun eine neue ANALYSE (für Meier Gudrun) mache und diese wieder speichern möchte, bekomme ich als Ziel E:\Dokumente\Auswertungen\Ergebnisse\Ergebnis_Meier Gudrun.xls vorgeschlagen.
Gruß
Joachim
AW: Blattschutz!
Josef
Hallo Joachim!
Geht auch!
Dafür nehmen wir einen Definierten Namen als Speicher!
Definiere zuerst einen Namen (Einfügen &gt Name &gt Definieren).
Als "Name:" gibst du "Pfad" ein und bei "Bezieht sich auf:" "=C:\", jeweils ohne Anführungszeichen!
Dann nimmst du diesen Code!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Speichern_BeiKlick()
Dim objWb As Workbook, objMe As Worksheet
Dim objVBComp As Object
Dim objShape As Shape
Dim objName As Name
Dim strFileName As String, strPath As String
Dim rng As Range

Set objMe = Sheets("ANALYSE")

strFileName = Trim$(objMe.Range("E1"))
strPath = Mid(objMe.Parent.Names("Pfad").Value, 2)
If Dir(strPath) = "" Then strPath = "C:\"
If strFileName = "" Then
  MsgBox "Bitte Eintrag in Zelle [E1] vornehmen!" & Space(20) & vbLf & _
    "Der Vorgang wird abgebrochen!", 64, "Hinweis"
  Exit Sub
End If

strFileName = strFileName & ".xls"

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .DisplayAlerts = False
  .Calculation = xlCalculationManual
End With

objMe.Copy

Set objWb = ActiveWorkbook

With objWb
  .Sheets(1).Name = "Ergebnis"
  .Sheets(1).Unprotect "abc" ' wenn ohne Passwort geschützt, dann .Sheets(1).Unprotect !
  On Error Resume Next
  
  For Each rng In .Sheets(1).Cells.SpecialCells(xlCellTypeFormulas, 23) 'Formel in Werte
    rng = rng.Value
  Next
  
  For Each rng In .Sheets(1).Cells.SpecialCells(xlCellTypeAllFormatConditions) 'Bedingte Formatierung entfernen
    rng.FormatConditions(1).Delete
    rng.FormatConditions(2).Delete
    rng.FormatConditions(3).Delete
  Next
  
  .Sheets(1).Cells.SpecialCells(xlCellTypeAllValidation).Validation.Delete 'Gültigkeiten entfernen
  
  Err.Clear
  On Error GoTo ErrExit
  .Sheets(1).Range("P1:IV65536").Delete
  .Sheets(1).Range("A101:IV65536").Delete
  .Sheets(1).Range("A1:O100").Interior.ColorIndex = xlNone
  
  For Each objName In .Names 'Definierte Namen entfernen
    objName.Delete
  Next
  
  For Each objVBComp In .VBProject.VBComponents 'VBA-Code entfernen
    With objVBComp.CodeModule
      .DeleteLines 1, .CountOfLines
    End With
  Next
  
  For Each objShape In .Sheets(1).Shapes 'Schaltflächen/Shapes entfernen
    objShape.Delete
  Next
  
  Application.Dialogs(xlDialogSaveAs).Show strPath & "Ergebnis " & strFileName
  strFileName = .FullName
  objMe.Parent.Names("Pfad").Value = "=" & .Path & "\"
  .Close True
  
End With

Set objWb = Workbooks.Open(strFileName)
With objWb
  For Each objVBComp In .VBProject.VBComponents 'VBA-Code entfernen
    With objVBComp.CodeModule
      .DeleteLines 1, .CountOfLines
    End With
  Next
  .Save
  .Close True
End With

ErrExit:

Set objWb = Nothing

If Err.Number > 0 Then
  MsgBox Err.Number & vbLf & Err.Description, , "Fehler"
  Err.Clear
End If

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .DisplayAlerts = True
  .Calculation = xlCalculationAutomatic
End With

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Blattschutz! - (Speicherort)
Joachim
Hallo Sepp,
irgendwie verstehe ich nicht:
Du schreibst:
Dafür nehmen wir einen Definierten Namen als Speicher!
Definiere zuerst einen Namen (Einfügen &gt Name &gt Definieren).
Als "Name:" gibst du "Pfad" ein und bei "Bezieht sich auf:" "=C:\", jeweils ohne Anführungszeichen!
?
Nochmal - die Funktion des jetzigen Makros geht ja direkt auf das Verzeichnis C:\ und schlägt dieses als Speicherort vor.
Der Dateiname ist mit: -Ergebnis (Eintrag aus Zelle E1).xls- vorgeschlagen.
(Daran soll sich ja auch nichts ändern.)
Bezgl. des Speicherortes -stelle ICH mir vor im Prinzip auch keine Änderung- ausser, dass das Verzeichnis, welches ich auswähle als Notiz in die Tabelle geht, um beim Nächsten Mal als Vorschlag zu dienen -anstelle jetzt C:\-.
Mit dem was du mir genannt hast komme ich nicht klar - ich weiss nicht genau was ich machen soll- Du verstehtst die Dörfer da in Böhmen..
Gruß
Jo
AW: Blattschutz! - (Speicherort)
Josef
Hallo Joachim!
Genau das macht mein Code! Aber dazu muss der letzte gewählte Pfad irgendwo
gespeichert werden! Und dazu brauchen wir den Namen "Pfad".
Oder woher soll der Code wissen, wo zuletzt gespeichert wurde?
Wie definiere ich einen Namen:
  • Blattschutz aufheben

  • "Einfügen" &gt "Name" &gt "Definieren"

  • Unter "Namen der Arbeitsmappe:" schreibst du "Pfad" (ohne Anführunsstriche)

  • Unter "Bezieht sich auf:" schreibst du "=C:\" (ohne Anführunsstriche)

  • "Hinzufügen" &gt "OK"

  • Dann meinen Code ausprobieren!
    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    AW: Blattschutz! - (Speicherort)
    Joachim
    Hallo Sepp,
    Ja - ich war mit VB-Fenster beschäftigt und dachte garnicht mehr an die ExcelTabelle -wo ich dies ja einfügen muss. Denn im VB-fenster ist ja im Menü nix mit Name.....
    _Bin einfach ein bischen unklar im Kopf_ Hoffentlich wirds nicht schlimmer... ;-)_____
    Nun habe ich dies auch gemacht - jedoch Laufzeitfehler '52' Dateiname oder -nummer falsch
    Der Debugger verweist darauf:
    If Dir(strPath) = "" Then strPath = "C:\"
    ?
    Der Dateiname ist ja Ergebnis + Inhalt E1.xls
    Gruß
    Joachim
    AW: Blattschutz! - (Speicherort)
    Josef
    Hallo Joachim!
    Scahu mal unter dem Namen, was dort steht! Steht dort ="C:\", oder "=C:\"?
    Es muss dort =C:\ stehen
    Ich sagte Ohne Anfürungszeichen!
    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    AW: Blattschutz! - (Speicherort)
    Joachim
    Hi,
    genauso steht's dort - also =C:\
    Gruß
    Jo
    AW: Blattschutz! - (Speicherort)
    Josef
    Hallo Joachim!
    Dann Probier mal diesen Code!
    ' **********************************************************************
    ' Modul: Modul1 Typ: Allgemeines Modul
    ' **********************************************************************

    Option Explicit

    Private Declare Function PathIsDirectory Lib "shlwapi.dll" Alias "PathIsDirectoryA" ( _
      ByVal pszPath As String) As Long

    Sub Speichern_BeiKlick()
    Dim objWb As Workbook, objMe As Worksheet
    Dim objVBComp As Object
    Dim objShape As Shape
    Dim objName As Name
    Dim strFileName As String, strPath As String
    Dim rng As Range

    Set objMe = Sheets("ANALYSE")

    strFileName = Trim$(objMe.Range("E1"))
    strPath = Mid(objMe.Parent.Names("Pfad").Value, 2)
    If PathIsDirectory(strPath) = 0 Then strPath = "C:\"
    If strFileName = "" Then
      MsgBox "Bitte Eintrag in Zelle [E1] vornehmen!" & Space(20) & vbLf & _
        "Der Vorgang wird abgebrochen!", 64, "Hinweis"
      Exit Sub
    End If

    strFileName = strFileName & ".xls"

    On Error GoTo ErrExit

    With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .DisplayAlerts = False
      .Calculation = xlCalculationManual
    End With

    objMe.Copy

    Set objWb = ActiveWorkbook

    With objWb
      .Sheets(1).Name = "Ergebnis"
      .Sheets(1).Unprotect "abc" ' wenn ohne Passwort geschützt, dann .Sheets(1).Unprotect !
      On Error Resume Next
      
      For Each rng In .Sheets(1).Cells.SpecialCells(xlCellTypeFormulas, 23) 'Formel in Werte
        rng = rng.Value
      Next
      
      For Each rng In .Sheets(1).Cells.SpecialCells(xlCellTypeAllFormatConditions) 'Bedingte Formatierung entfernen
        rng.FormatConditions(1).Delete
        rng.FormatConditions(2).Delete
        rng.FormatConditions(3).Delete
      Next
      
      .Sheets(1).Cells.SpecialCells(xlCellTypeAllValidation).Validation.Delete 'Gültigkeiten entfernen
      
      Err.Clear
      On Error GoTo ErrExit
      .Sheets(1).Range("P1:IV65536").Delete
      .Sheets(1).Range("A101:IV65536").Delete
      .Sheets(1).Range("A1:O100").Interior.ColorIndex = xlNone
      
      For Each objName In .Names 'Definierte Namen entfernen
        objName.Delete
      Next
      
      For Each objVBComp In .VBProject.VBComponents 'VBA-Code entfernen
        With objVBComp.CodeModule
          .DeleteLines 1, .CountOfLines
        End With
      Next
      
      For Each objShape In .Sheets(1).Shapes 'Schaltflächen/Shapes entfernen
        objShape.Delete
      Next
      
      Application.Dialogs(xlDialogSaveAs).Show strPath & "Ergebnis " & strFileName
      strFileName = .FullName
      objMe.Parent.Names("Pfad").Value = "=" & .Path & "\"
      .Close True
      
    End With

    Set objWb = Workbooks.Open(strFileName)
    With objWb
      For Each objVBComp In .VBProject.VBComponents 'VBA-Code entfernen
        With objVBComp.CodeModule
          .DeleteLines 1, .CountOfLines
        End With
      Next
      .Save
      .Close True
    End With

    ErrExit:

    Set objWb = Nothing

    If Err.Number > 0 Then
      MsgBox Err.Number & vbLf & Err.Description, , "Fehler"
      Err.Clear
    End If

    With Application
      .ScreenUpdating = True
      .EnableEvents = True
      .DisplayAlerts = True
      .Calculation = xlCalculationAutomatic
    End With

    End Sub


    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    AW: Tabellenblatt speichern....
    Joachim
    Hallo Sepp,
    es wird etwas knapp am rechten Rand deshalb hier weiter...
    --------------
    Also mit diesem Code ist's OK - kein Fehler. Jedoch..
    Er merkt sich NICHT den letzten Speicherort, wenn ich eine neue Ergebnistabelle speichern möchte.
    Ich lande wieder auf C:\ mein letztes Zielverzeichnis war 5 Ebenen tiefer.
    Grüsse
    Joachim
    AW: Tabellenblatt speichern....
    Joachim
    Hallo Sepp,
    kann man den Cursor -wenn kein Eintrag in E1 erfolgt ist und der Vorgang abgebrochen wird, nach der Bestätigung des Hinweisfensters in die Zelle springen lassen so, dass der Nutzer nur noch den Eintrag machen muss?
    Gruß
    Joachim
    AW: Tabellenblatt speichern....
    Josef
    Hallo Joachim!
    Dein System ist "Bockig";-))
    Ändere die Zeile
    
    strPath = Mid(objMe.Parent.Names("Pfad").Value, 2)
    

    um in
    
    strPath = Mid(objMe.Parent.Names("Pfad").RefersToLocal, 2)
    

    dann sollte es laufen!
    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    AW: Tabellenblatt speichern....
    Joachim
    Hallo Sepp,
    BINGO nun Klappt's.
    Vielen Dank.
    --------------
    Habe noch eine Kleinigkeit entdeckt:
    Wenn ich den Speicherdialog durchführe und dann aber NICHT speichere sondern abbreche, kommt die Meldung ----Nicht gefunden....
    Muss dann noch 2x Abbrechen bis zum tatsächlichen abbrechen und habe dann eine ungespeicherte Tabelle mit Namen MappeX.xls in Excel.
    Ist nicht unbedingt schlimm - kann man mit leben.
    ------------------
    Gibt es in Excel eine Formel oder einen Menüpunkt der alle Inhalte in ungesperrten Zellen
    auf einmal löscht? oder braucht dafür auch wieder einen einen VBA-Code?
    --------------------------------
    Viel Grüße
    Joachim
    AW: Tabellenblatt speichern....
    Josef
    Hallo Joachim!
    Auch das lässt sich abfangen!
    ' **********************************************************************
    ' Modul: Modul1 Typ: Allgemeines Modul
    ' **********************************************************************

    Option Explicit

    Private Declare Function PathIsDirectory Lib "shlwapi.dll" Alias "PathIsDirectoryA" ( _
      ByVal pszPath As String) As Long

    Sub Speichern_BeiKlick()
    Dim objWb As Workbook, objMe As Worksheet
    Dim objVBComp As Object
    Dim objShape As Shape
    Dim objName As Name
    Dim strFileName As String, strPath As String
    Dim rng As Range
    Dim lngResult As Long

    Set objMe = Sheets("ANALYSE")

    strFileName = Trim$(objMe.Range("E1"))
    strPath = Mid(objMe.Parent.Names("Pfad").RefersToLocal, 2)
    If PathIsDirectory(strPath) = 0 Then strPath = "C:\"
    If strFileName = "" Then
      MsgBox "Bitte Eintrag in Zelle [E1] vornehmen!" & Space(20) & vbLf & _
        "Der Vorgang wird abgebrochen!", 64, "Hinweis"
      Exit Sub
    End If

    strFileName = strFileName & ".xls"

    On Error GoTo ErrExit

    With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .DisplayAlerts = False
      .Calculation = xlCalculationManual
    End With

    objMe.Copy

    Set objWb = ActiveWorkbook

    With objWb
      .Sheets(1).Name = "Ergebnis"
      .Sheets(1).Unprotect "abc" ' wenn ohne Passwort geschützt, dann .Sheets(1).Unprotect !
      On Error Resume Next
      
      For Each rng In .Sheets(1).Cells.SpecialCells(xlCellTypeFormulas, 23) 'Formel in Werte
        rng = rng.Value
      Next
      
      For Each rng In .Sheets(1).Cells.SpecialCells(xlCellTypeAllFormatConditions) 'Bedingte Formatierung entfernen
        rng.FormatConditions(1).Delete
        rng.FormatConditions(2).Delete
        rng.FormatConditions(3).Delete
      Next
      
      .Sheets(1).Cells.SpecialCells(xlCellTypeAllValidation).Validation.Delete 'Gültigkeiten entfernen
      
      Err.Clear
      On Error GoTo ErrExit
      .Sheets(1).Range("P1:IV65536").Delete
      .Sheets(1).Range("A101:IV65536").Delete
      .Sheets(1).Range("A1:O100").Interior.ColorIndex = xlNone
      
      For Each objName In .Names 'Definierte Namen entfernen
        objName.Delete
      Next
      
      For Each objVBComp In .VBProject.VBComponents 'VBA-Code entfernen
        With objVBComp.CodeModule
          .DeleteLines 1, .CountOfLines
        End With
      Next
      
      For Each objShape In .Sheets(1).Shapes 'Schaltflächen/Shapes entfernen
        objShape.Delete
      Next
      
      lngResult = Application.Dialogs(xlDialogSaveAs).Show(strPath & "Ergebnis " & strFileName)
      
      If lngResult = 0 Then
        .Close False
        MsgBox "Vorgang abgebrochen!", 64, "Abbruch"
      Else
        strFileName = .FullName
        objMe.Parent.Names("Pfad").Value = "=" & .Path & "\"
        .Close True
      End If
    End With

    If lngResult <> 0 Then
      Set objWb = Workbooks.Open(strFileName)
      With objWb
        For Each objVBComp In .VBProject.VBComponents 'VBA-Code entfernen
          With objVBComp.CodeModule
            .DeleteLines 1, .CountOfLines
          End With
        Next
        .Save
        .Close True
      End With
    End If

    ErrExit:

    Set objWb = Nothing

    If Err.Number > 0 Then
      MsgBox Err.Number & vbLf & Err.Description, , "Fehler"
      Err.Clear
    End If

    With Application
      .ScreenUpdating = True
      .EnableEvents = True
      .DisplayAlerts = True
      .Calculation = xlCalculationAutomatic
    End With

    End Sub


    Zum Löschen der ungesperrten Zellen, zwei Möglichkeiten!
    ' **********************************************************************
    ' Modul: Modul2 Typ: Allgemeines Modul
    ' **********************************************************************

    Option Explicit

    Sub UngesperrteLoeschen1()
    Dim rng As Range

    For Each rng In Range("A1:O100")
      If Not rng.Locked Then rng.ClearContents
    Next

    End Sub


    'Oder den ungesperrten Zellen einen Namen geben z.B. "Eingabe"
    Sub UngesperrteLoeschen2()
    Range("Eingabe").ClearContents
    End Sub


    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    AW: Tabellenblatt speichern....
    Joachim

    Hallo Sepp,
    nun haben wir's.
    Supertoll - vielen Dank. Du hast mir sehr geholfen.
    Werde jetzt noch ein Schaltfläche für "Inhalte Löschen" einbauen.
    (Hoffe es klappt:::)
    Nach weiteren Tests melde ich mich nocheinmal.
    Grüsse aus Düsseldorf
    Joachim
    AW: Tabellenblatt speichern....
    Joachim

    Hallo Sepp,
    in deinem Makro:
    -------------------------
    ' **********************************************************************
    ' Modul: Modul2 Typ: Allgemeines Modul
    ' **********************************************************************
    Option Explicit
    
    Sub UngesperrteLoeschen1()
    Dim rng As Range
    For Each rng In Range("A1:O100")
    If Not rng.Locked Then rng.ClearContents
    Next
    End Sub
    

    --------------------
    hast du den Bereich A1:O100 definiert.
    Es gibt einige Zellen in diesem Bereich die verbundene Zellen sind.
    Bei ausführen des Makros wird dieses reklamiert -Kann Teile von verbundenen Zellen...
    Ich bin nun daran gegangen jede einzelne Zelle zu benennen - Also:
    E1;e52; ect.
    Doch auch hier Fehleanzeige.
    Dann habe ich noch abgewandelt auf:
    E1,E52, ect
    Das selbe Ergebnis.
    Wie könnte die Lösung aussehen?
    ------------------------
    Zum Makrostart habe ich ein Steuerelement in die Tabelle eingefügt und mit dem Makro verknüpft. OK - es funktioniert.
    Nur mir will die Beschriftung nicht gelingen.
    Es ist der vordefinierte Text CommandButton2 zu sehen - ich möchte aber anstelle dessen den Text:
    Zellinhalte löschen (oder so ähnlich) - wie geht dies?
    Gruß
    Joachim
    AW: Tabellenblatt speichern....
    Josef

    Hallo Joachim!
    Verbundene Zellen sind ein Fluch im Bezug auf VBA!
    So geht's
    Sub UngesperrteLoeschen1()
    Dim rng As Range, c As Range

    For Each rng In Range("A1:O100")
      If Not rng.Locked Then
        If rng.MergeCells Then
          rng.MergeArea.ClearContents
        Else
          rng.ClearContents
        End If
      End If
    Next

    End Sub


    Zum Commandbutton:
    Rechtsklick &gt Eigenschaften &gt Caption
    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    Formel kopieren - Fehlanzeige....?
    Joachim

    Hallo Sepp,
    was wär ich ohne dich?
    Es gibt vieles zu lernen.
    Danke an den Exorzisten - der der den Fluch beseitigt.
    Schönen Sonntag.
    ---------------
    Noch ein Fluch -oder?
    Bei meiner Tabelle habe ich ALLE Passwortabfragen abgeschaltet.
    Die Mappe arbeitet ohne Schutz.
    Nun möchte ich eine Formel kopieren und in andere Zellen einfügen.
    Doch nachdem ich eine Zelle kopiert habe -sie wird durch den animierten Rahmen markiert-
    gehe ich nun auf die Zellen in die diese Formelkopiert werden sollen.
    Sobald ich die Zielzellen markiert habe - hebt sich die Markierung der Quellzelle auf.
    Waran kann dies nur liegen?
    Gruß
    Joachim
    AW: Formel kopieren - Fehlanzeige....?
    Josef

    Hallo Joachim!
    Das liegt an dem Makro zum färben der aktiven Zelle!
    Das kannst du so umgehen.
    ' **********************************************************************
    ' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
    ' **********************************************************************

    Option Explicit

    Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

    'ActiveSheet.Unprotect ("abc")
    Static Zelle As Range
    If Application.CutCopyMode Then Exit Sub
    If Not Zelle Is Nothing Then
      Cells.Interior.ColorIndex = xlColorIndexNone
    End If
    Target.Interior.ColorIndex = 6 ' Gelb
    Set Zelle = Target

    'ActiveSheet.Protect ("abc")

    End Sub


    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    Sprung in erste Zelle...?
    Joachim

    Hallo Sepp,
    auch diesen FLUCH hast du gebannt...
    Ich weis zwar nicht wie - denn ich habe genau das Selbe schon gemacht- aber
    es waren wohl deine mystischen Kräfte nötig ;-)).
    -------------------
    Nun gibt es noch die Frage:
    1.)Kann man das Makro -Speichern des Ergebnisses so einstellen, dass, wenn in Zelle E1 kein Eintrag ist - kommt ja die Fehlermeldung - bitte Eintrag vornehmen..., der Cursor nach Bestätigen dieses Fehlerhinweises automatisch in die Zelle E1 springt und auf die Eingabe wartet?
    2.) Meine Mappe hat mehrere Seiten. Nach dem Öffnen wird mir immer das letzte Tabellenblatt als erstes angezeigt.
    Kann man es so einrichten, dass immer das erste Tabellenblatt (ANALYSE) immer als erstes angezeigt wird?
    Gruß
    Joachim
    AW: Sprung in erste Zelle...?
    Josef

    Hallo Joachim!
    Zu 1:
    Diese Codezeilen austauschen.
    If strFileName = "" Then
      MsgBox "Bitte Eintrag in Zelle [E1] vornehmen!" & Space(20) & vbLf & _
        "Der Vorgang wird abgebrochen!", 64, "Hinweis"
      Application.Goto objMe.Range("E1")
      Exit Sub
    End If

    Zu 2:
    In das Modul "DieseArbeitsmappe" diesen Code kopieren,
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Sheets("ANALYSE").Activate
    End Sub


    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    Ansicht erste Tabelle...
    Joachim

    Hallo Sepp,
    super - das mit dem Sprung in Zelle E1 - Top Klappt..
    Mit dem Code für die Arbeitsmappe, habe ich ein Problem.
    Ich schicke die hier den gesamten Code für die Sektion ARBEITSMAPPE:
    Option Explicit
    
    Private Sub Workbook_Activate()
    Application.OnKey "^{F12}", "AdminMode"
    End Sub
    

    
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim aw
    If Not ThisWorkbook.Saved Then
    aw = MsgBox("Sollen ihre Änderungen in " & ThisWorkbook.Name & " gespeichert werden?", vbExclamation + vbYesNoCancel)
    If aw = vbYes Then MappeSpeichern
    If aw = vbNo Then ThisWorkbook.Saved = True
    If aw = vbCancel Then Cancel = True
    End If
    End Sub
    

    
    Private Sub Workbook_Deactivate()
    Application.OnKey "^{F12}"
    End Sub
    

    
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
    If SaveAsUI Then
    MsgBox "Datei kann nicht unter anderem Namen gespeichert werden!"
    Exit Sub
    End If
    ThisWorkbook.Saved = MappeSpeichern
    End Sub
    

    
    Private Sub Workbook_Open()
    Dim sh As Worksheet
    Dim ok As Boolean
    Dim Meldung As String
    ThisWorkbook.IsAddin = True
    'Lizenz prüfen:
    ok = False
    If SerienNr_Blatt = "" Then
    'noch nicht lizensiert:
    If Datum_Blatt = "" Then Set_Datum_Blatt Date
    If Date > CDate(Datum_Blatt) Then
    'zu spät!
    Meldung = "Die Lizensierungsmöglichkeit ist abgelaufen!" & vbLf & _
    "Bitte wenden Sie sich an ...."
    Else
    'Programm lizensieren
    Set_SerienNr_Blatt SerienNummer
    Set_Datum_Blatt FormatDateTime(Date, vbShortDate)
    Application.EnableEvents = False
    ThisWorkbook.Save
    Application.EnableEvents = True
    ok = True
    'Meldung = "Das Programm wurde soeben für Ihren Rechner lizensiert." & vbLf & _
    "Viel Spaß!"
    End If
    Else
    'schon lizensiert:
    If SerienNr_Blatt <> SerienNummer Then
    'falsche Festplatten-ID
    Meldung = "Das Programm für auf einem anderen PC lizensiert." & vbLf & _
    "Vielleicht haben Sie auch die Festplatte gewechselt." & vbLf & vbLf & _
    "Bitte wenden Sie sich an ...."
    Else
    ok = True
    End If
    End If
    'If Not ok Then ActiveWindow.Visible = False
    If Meldung <> "" Then
    Application.EnableCancelKey = xlDisabled
    MsgBox Meldung
    Application.EnableCancelKey = xlInterrupt
    End If
    ThisWorkbook.IsAddin = False
    If Not ok Then
    ThisWorkbook.Close False
    Exit Sub
    End If
    'Alle Blätter einblenden
    For Each sh In Worksheets
    If sh.Name <> MakroBlatt Then
    sh.Visible = True
    End If
    Next sh
    'Infoblatt ausblenden
    Sheets(MakroBlatt).Visible = xlSheetVeryHidden
    ThisWorkbook.Saved = True
    End Sub
    

    --------------------------
    Wo soll ich den zusätzlichen Code einbauen, da ja:
    
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    schon vorhanden ist. Komme dann natürlich auf eine Fehlermeldung
    Diese Arbeitsmappe ist als Excelobjekt definiert nicht als Modul.
    Gruß
    Joachim
    
    AW: Ansicht erste Tabelle...
    Josef

    Hallo Joachim!
    So sollte es klappen!
    ' **********************************************************************
    ' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
    ' **********************************************************************

    Option Explicit

    Private Sub Workbook_Activate()
    Application.OnKey "^{F12}", "AdminMode"
    End Sub




    Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim aw
    If Not ThisWorkbook.Saved Then
      aw = MsgBox("Sollen ihre Änderungen in " & ThisWorkbook.Name & " gespeichert werden?", vbExclamation + vbYesNoCancel)
      If aw = vbYes Then
        Sheets("ANALYSE").Activate
        MappeSpeichern
      ElseIf aw = vbNo Then
        Sheets("ANALYSE").Activate
        ThisWorkbook.Saved = True
      Else
        Cancel = True
      End If
    Else
      Sheets("ANALYSE").Activate
    End If

    End Sub




    Private Sub Workbook_Deactivate()
    Application.OnKey "^{F12}"
    End Sub





    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Cancel = True
    If SaveAsUI Then
      MsgBox "Datei kann nicht unter anderem Namen gespeichert werden!"
      Exit Sub
    End If

    ThisWorkbook.Saved = MappeSpeichern

    End Sub




    Private Sub Workbook_Open()
    Dim sh As Worksheet
    Dim ok As Boolean
    Dim Meldung As String

    ThisWorkbook.IsAddin = True

    'Lizenz prüfen:
    ok = False
    If SerienNr_Blatt = "" Then
      'noch nicht lizensiert:
      If Datum_Blatt = "" Then Set_Datum_Blatt Date
      If Date > CDate(Datum_Blatt) Then
        'zu spät!
        Meldung = "Die Lizensierungsmöglichkeit ist abgelaufen!" & vbLf & _
          "Bitte wenden Sie sich an ...."
      Else
        'Programm lizensieren
        Set_SerienNr_Blatt SerienNummer
        Set_Datum_Blatt FormatDateTime(Date, vbShortDate)
        Application.EnableEvents = False
        ThisWorkbook.Save
        Application.EnableEvents = True
        ok = True
        'Meldung = "Das Programm wurde soeben für Ihren Rechner lizensiert." & vbLf & _
          "Viel Spaß!"

      End If
    Else
      'schon lizensiert:
      If SerienNr_Blatt <> SerienNummer Then
        'falsche Festplatten-ID
        Meldung = "Das Programm für auf einem anderen PC lizensiert." & vbLf & _
          "Vielleicht haben Sie auch die Festplatte gewechselt." & vbLf & vbLf & _
          "Bitte wenden Sie sich an ...."
      Else
        ok = True
      End If
    End If

    'If Not ok Then ActiveWindow.Visible = False

    If Meldung <> "" Then
      Application.EnableCancelKey = xlDisabled
      MsgBox Meldung
      Application.EnableCancelKey = xlInterrupt
    End If

    ThisWorkbook.IsAddin = False

    If Not ok Then
      ThisWorkbook.Close False
      Exit Sub
    End If

    'Alle Blätter einblenden
    For Each sh In Worksheets
      If sh.Name <> MakroBlatt Then
        sh.Visible = True
      End If
    Next sh
    'Infoblatt ausblenden
    Sheets(MakroBlatt).Visible = xlSheetVeryHidden

    ThisWorkbook.Saved = True
    End Sub


    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    AW: Ansicht erste Tabelle...
    Joachim

    Hallo Sepp,
    zunächst - klappt es.....
    aber nur beim ersten Mal - nach dem ich eine -unregistrierte- Mappe das erste Mal aufrufe. Dann erscheint wirklich Tabelle 1 als erstes Blatt.
    Wenn anschließend diese Mappe erneut aufgerufen wird, -nachdem sie für den Rechner registriert wurde-, erscheint auch wieder die Tabelle 1 als erstes Blatt.
    Sobald ich jedoch die Mappe einmal gespeíchert habe (nachdem sie registriert wurde) erscheint immer die Tabelle 5 als erstes (aktives) Blatt.
    Es scheint wohl ein Wurm darin zu sein. Auch auf einem anderen Rechner ist es das Gleiche. Ich habe dies ausprobiert, da du ja mal sagtest, dass mein System -bockig- ist.
    Daran kann es also nicht liegen.
    Vielleicht schaust du bitte nocheinmal in den Code - evt. findest du noch eine Lösung, ansonsten muss ich eben damit leben.
    Viele liebe Grüße
    Joachim
    AW: Ansicht erste Tabelle...
    Josef

    Hallo Joachim!
    Was passiert in "MappeSpeichern" ?
    Du könntest auch im "Workbook_Open", nach der Zeile
    
    ThisWorkbook.IsAddin = True
    

    noch
    
    Sheets("ANALYSE").Activate
    

    Einfügen
    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    AW: Ansicht erste Tabelle...
    Joachim

    Hallo Sepp,
    das war es wohl..
    Nun klappt es!!
    Hurra...!!!!
    Nochmals vielen Dank für deine wertvolle Hilfe.
    Excel kann einen schon begeistern!
    Ich werde mich mit den unglaublichen Möglichkeiten von der VBA Programmierung nun
    intensiv auseinandersetzen.
    Man kann ja wohl mit Excel sogar auf dem Mond landen.... ;-)).
    Werde nun alles nochmal auf Herz und Nieren testen.
    --------------
    Bringt es etwas für die -Sicherheit ;-) - wenn man die Passwörter im HexFormat eingibt?
    oder ist das -Removing- damit genauso einfach?
    Geht dies überhaupt?
    -------------------
    Bei meinen Webseiten mach ich dies immer mit meinen mailadressen die im HTML-Code stehen. Seitdem habe ich nicht mehr soviel Ärger mit SPAM. Ja sogar die Adreesen die ich im HexCode eingeben habe sind noch nie in irgendwelchen Spamlisten aufgetaucht.
    Ist nur so eine Idee, um Crackern zumidest die Arbeit zu erschweren.
    --------------------
    Gibt es Begrenzungen bezgl. der Länge von Passwörtern für die jeweiligen Bereiche:
    Blattschutz - Arbeitsmappenschutz - VBA-Projekte?
    --------------------
    Alles Gute
    Joachim
    AW: Ansicht erste Tabelle...
    Josef

    Hallo Joachim!
    Ob Passwörter im Hex-Format akzeptiert werden weis ich nicht, glaube aber
    das der Schutz gleich leicht/schwer geknackt werden kann!
    Die maximale Länge der Passwörter beträgt beim Blatt- und Arbeitsmappen-Schutz 255 Zeichen, beim VBA-Projekt 32 Zeichen.
    Gruß Sepp
    AW: Ansicht erste Tabelle...
    Joachim

    Hallo Sepp,
    habs mir gedacht - war auch nur so eine Idee...
    -----------------
    Nun habe ich in einem anderen Thread von HansHei den Tipp gesehen die Menüleiste auszublenden - habe dies ebenfalls eingebaut - Funktioniert perfekt.
    ----------------
    Zur Abrundung: wie sehen die Codes für die Zeilen- und Spaltenüberschriften und die Bearbeitungszeile aus?
    Wenn ich dies ebenfalls mit einbinde - habe ich erstens eine größere Arbeitsfläche und ausserdem eine weitere Manipulationsmöglichkeit ausgeschaltet, da ich ja an keinen Menüpunkt mehr gelange.
    -------------------
    Meinen Code für die Menüabschaltung habe ich wie folgt integriert:
    Modul4 angelegt.
    Inhalt:
    Sub Einblenden()
    Dim cb As CommandBar
    For Each cb In Application.CommandBars
    cb.Enabled = True
    Next
    End Sub
    Sub Ausblenden()
    Dim cb As CommandBar
    For Each cb In Application.CommandBars
    cb.Enabled = False
    Next
    End Sub
    Dann in der Arbeitsmappe:
    1stens.
    
    Private Sub Workbook_Activate()
    Ausblenden ...............................eingefügt
    Application.OnKey "^{F12}", "AdminMode"
    End Sub
    

    2tens
    
    Private Sub Workbook_Deactivate()
    Einblenden................................eingefügt
    Application.OnKey "^{F12}"
    End Sub
    

    -----------------
    Gruß
    Joachim
    AW: Ansicht erste Tabelle...
    Josef

    Hallo Joachim!
    Dazu musst du noch folgendes einfügen1
    Private Sub Workbook_Activate()

    Application.DisplayFormulaBar = False

    End Sub


    Private Sub Workbook_Deactivate()

    Application.DisplayFormulaBar = True
    ActiveWindow.DisplayHeadings = True

    End Sub



    'Die Zeilen- und Spaltenbeschriftung bezieht sich immer auf das aktive Fenster
    Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    ActiveWindow.DisplayHeadings = False
    End Sub


    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    AW: Ansicht Mappen...
    Joachim

    Hallo Sepp,
    super - klappt hervorragend, aber...
    nun hab eich etwas damit angestellt.
    Selbst wenn ich nun eine andere Mappe öffne sind das Menür - die Zeilen- und Spaltenüberschriften und die Bearbeitungszeile deaktiviert....
    Wie bekomme ich dies nun wieder hin?
    Wird Excel mit diesen Codes grundsätzlich nun so eingestellt?
    Für alle anderen Mappen und Blätter sollten aber die Standardeinstellungen - wie sie in den Einstellungsoptionen vorgegeben wurden nicht verändert werden /sein.
    Gruß
    Joachim
    AW: Ansicht Mappen...
    Josef

    Hallo Joachim!
    Wenn du die Codes für die Menüs und die FormulaBar im richtigen Ereignis stehen hast,
    dann werden sie auch aus/eingeblendet!
    Die Zeilen und Spaltenbeschriftung bezieht sich, wie gesagt, immer auf das aktive
    Fenster. Mann kann es also nicht einer Tabelle oder Mappe zuweisen. Ich würde darauf verzichten!
    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    Zeilen- Spalten ect. ausblenden....?
    Joachim

    Hallo Sepp,
    mal wieder besser hier weiter.
    ---------------------------------
    Warum weiss ich nicht - aber nu nist der Fehler weg. ......
    Es gibt leider ein kleines anderes Problem:
    Die speichern Funktion - Analyse als Bericht speichern unter geht nun nicht mehr.
    Trotz Eingabe werde ich zur Eingabe aufgefordert....?
    Beeinflusst sich dort nun etwas zum Nachteil?
    ------------------------------------------------------
    Die Tabelle 3 und die Tabelle 4 - möchte ich bei Bedarf ausdrucken können.
    Wenn nun das Menü verborgen ist - kann ich einfach einen Button mit der Beschriftung DRUCKEN auf den Seiten einbauen und auf diesen den Befehl Strg + P legen?
    Wie weise ich solch einem Steuerelement diesen Befehl zu?
    ----------------------------------
    Gruß
    Joachim
    AW: Tabellenblatt speichern....
    Joachim
    Hallo Sepp,
    nun haben wir's.
    Supertoll - vielen Dank. Du hast mir sehr geholfen.
    Werde jetzt noch ein Schaltfläche für "Inhalte Löschen" einbauen.
    (Hoffe es klappt:::)
    Nach weiteren Tests melde ich mich nocheinmal.
    Grüsse aus Düsseldorf
    Joachim
    AW: Tabellenblatt speichern....
    Joachim
    Hallo Sepp,
    in deinem Makro:
    -------------------------
    ' **********************************************************************
    ' Modul: Modul2 Typ: Allgemeines Modul
    ' **********************************************************************
    Option Explicit
    
    Sub UngesperrteLoeschen1()
    Dim rng As Range
    For Each rng In Range("A1:O100")
    If Not rng.Locked Then rng.ClearContents
    Next
    End Sub
    

    --------------------
    hast du den Bereich A1:O100 definiert.
    Es gibt einige Zellen in diesem Bereich die verbundene Zellen sind.
    Bei ausführen des Makros wird dieses reklamiert -Kann Teile von verbundenen Zellen...
    Ich bin nun daran gegangen jede einzelne Zelle zu benennen - Also:
    E1;e52; ect.
    Doch auch hier Fehleanzeige.
    Dann habe ich noch abgewandelt auf:
    E1,E52, ect
    Das selbe Ergebnis.
    Wie könnte die Lösung aussehen?
    ------------------------
    Zum Makrostart habe ich ein Steuerelement in die Tabelle eingefügt und mit dem Makro verknüpft. OK - es funktioniert.
    Nur mir will die Beschriftung nicht gelingen.
    Es ist der vordefinierte Text CommandButton2 zu sehen - ich möchte aber anstelle dessen den Text:
    Zellinhalte löschen (oder so ähnlich) - wie geht dies?
    Gruß
    Joachim
    AW: Tabellenblatt speichern....
    Josef
    Hallo Joachim!
    Verbundene Zellen sind ein Fluch im Bezug auf VBA!
    So geht's
    Sub UngesperrteLoeschen1()
    Dim rng As Range, c As Range

    For Each rng In Range("A1:O100")
      If Not rng.Locked Then
        If rng.MergeCells Then
          rng.MergeArea.ClearContents
        Else
          rng.ClearContents
        End If
      End If
    Next

    End Sub


    Zum Commandbutton:
    Rechtsklick &gt Eigenschaften &gt Caption
    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    Formel kopieren - Fehlanzeige....?
    Joachim
    Hallo Sepp,
    was wär ich ohne dich?
    Es gibt vieles zu lernen.
    Danke an den Exorzisten - der der den Fluch beseitigt.
    Schönen Sonntag.
    ---------------
    Noch ein Fluch -oder?
    Bei meiner Tabelle habe ich ALLE Passwortabfragen abgeschaltet.
    Die Mappe arbeitet ohne Schutz.
    Nun möchte ich eine Formel kopieren und in andere Zellen einfügen.
    Doch nachdem ich eine Zelle kopiert habe -sie wird durch den animierten Rahmen markiert-
    gehe ich nun auf die Zellen in die diese Formelkopiert werden sollen.
    Sobald ich die Zielzellen markiert habe - hebt sich die Markierung der Quellzelle auf.
    Waran kann dies nur liegen?
    Gruß
    Joachim
    AW: Formel kopieren - Fehlanzeige....?
    Josef
    Hallo Joachim!
    Das liegt an dem Makro zum färben der aktiven Zelle!
    Das kannst du so umgehen.
    ' **********************************************************************
    ' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
    ' **********************************************************************

    Option Explicit

    Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

    'ActiveSheet.Unprotect ("abc")
    Static Zelle As Range
    If Application.CutCopyMode Then Exit Sub
    If Not Zelle Is Nothing Then
      Cells.Interior.ColorIndex = xlColorIndexNone
    End If
    Target.Interior.ColorIndex = 6 ' Gelb
    Set Zelle = Target

    'ActiveSheet.Protect ("abc")

    End Sub


    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    Sprung in erste Zelle...?
    Joachim
    Hallo Sepp,
    auch diesen FLUCH hast du gebannt...
    Ich weis zwar nicht wie - denn ich habe genau das Selbe schon gemacht- aber
    es waren wohl deine mystischen Kräfte nötig ;-)).
    -------------------
    Nun gibt es noch die Frage:
    1.)Kann man das Makro -Speichern des Ergebnisses so einstellen, dass, wenn in Zelle E1 kein Eintrag ist - kommt ja die Fehlermeldung - bitte Eintrag vornehmen..., der Cursor nach Bestätigen dieses Fehlerhinweises automatisch in die Zelle E1 springt und auf die Eingabe wartet?
    2.) Meine Mappe hat mehrere Seiten. Nach dem Öffnen wird mir immer das letzte Tabellenblatt als erstes angezeigt.
    Kann man es so einrichten, dass immer das erste Tabellenblatt (ANALYSE) immer als erstes angezeigt wird?
    Gruß
    Joachim
    AW: Sprung in erste Zelle...?
    Josef
    Hallo Joachim!
    Zu 1:
    Diese Codezeilen austauschen.
    If strFileName = "" Then
      MsgBox "Bitte Eintrag in Zelle [E1] vornehmen!" & Space(20) & vbLf & _
        "Der Vorgang wird abgebrochen!", 64, "Hinweis"
      Application.Goto objMe.Range("E1")
      Exit Sub
    End If

    Zu 2:
    In das Modul "DieseArbeitsmappe" diesen Code kopieren,
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Sheets("ANALYSE").Activate
    End Sub


    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    Ansicht erste Tabelle...
    Joachim

    Hallo Sepp,
    super - das mit dem Sprung in Zelle E1 - Top Klappt..
    Mit dem Code für die Arbeitsmappe, habe ich ein Problem.
    Ich schicke die hier den gesamten Code für die Sektion ARBEITSMAPPE:
    Option Explicit
    
    Private Sub Workbook_Activate()
    Application.OnKey "^{F12}", "AdminMode"
    End Sub
    

    
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim aw
    If Not ThisWorkbook.Saved Then
    aw = MsgBox("Sollen ihre Änderungen in " & ThisWorkbook.Name & " gespeichert werden?", vbExclamation + vbYesNoCancel)
    If aw = vbYes Then MappeSpeichern
    If aw = vbNo Then ThisWorkbook.Saved = True
    If aw = vbCancel Then Cancel = True
    End If
    End Sub
    

    
    Private Sub Workbook_Deactivate()
    Application.OnKey "^{F12}"
    End Sub
    

    
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
    If SaveAsUI Then
    MsgBox "Datei kann nicht unter anderem Namen gespeichert werden!"
    Exit Sub
    End If
    ThisWorkbook.Saved = MappeSpeichern
    End Sub
    

    
    Private Sub Workbook_Open()
    Dim sh As Worksheet
    Dim ok As Boolean
    Dim Meldung As String
    ThisWorkbook.IsAddin = True
    'Lizenz prüfen:
    ok = False
    If SerienNr_Blatt = "" Then
    'noch nicht lizensiert:
    If Datum_Blatt = "" Then Set_Datum_Blatt Date
    If Date > CDate(Datum_Blatt) Then
    'zu spät!
    Meldung = "Die Lizensierungsmöglichkeit ist abgelaufen!" & vbLf & _
    "Bitte wenden Sie sich an ...."
    Else
    'Programm lizensieren
    Set_SerienNr_Blatt SerienNummer
    Set_Datum_Blatt FormatDateTime(Date, vbShortDate)
    Application.EnableEvents = False
    ThisWorkbook.Save
    Application.EnableEvents = True
    ok = True
    'Meldung = "Das Programm wurde soeben für Ihren Rechner lizensiert." & vbLf & _
    "Viel Spaß!"
    End If
    Else
    'schon lizensiert:
    If SerienNr_Blatt <> SerienNummer Then
    'falsche Festplatten-ID
    Meldung = "Das Programm für auf einem anderen PC lizensiert." & vbLf & _
    "Vielleicht haben Sie auch die Festplatte gewechselt." & vbLf & vbLf & _
    "Bitte wenden Sie sich an ...."
    Else
    ok = True
    End If
    End If
    'If Not ok Then ActiveWindow.Visible = False
    If Meldung <> "" Then
    Application.EnableCancelKey = xlDisabled
    MsgBox Meldung
    Application.EnableCancelKey = xlInterrupt
    End If
    ThisWorkbook.IsAddin = False
    If Not ok Then
    ThisWorkbook.Close False
    Exit Sub
    End If
    'Alle Blätter einblenden
    For Each sh In Worksheets
    If sh.Name <> MakroBlatt Then
    sh.Visible = True
    End If
    Next sh
    'Infoblatt ausblenden
    Sheets(MakroBlatt).Visible = xlSheetVeryHidden
    ThisWorkbook.Saved = True
    End Sub
    

    --------------------------
    Wo soll ich den zusätzlichen Code einbauen, da ja:
    
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    schon vorhanden ist. Komme dann natürlich auf eine Fehlermeldung
    Diese Arbeitsmappe ist als Excelobjekt definiert nicht als Modul.
    Gruß
    Joachim
    
    AW: Ansicht erste Tabelle...
    Josef

    Hallo Joachim!
    So sollte es klappen!
    ' **********************************************************************
    ' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
    ' **********************************************************************

    Option Explicit

    Private Sub Workbook_Activate()
    Application.OnKey "^{F12}", "AdminMode"
    End Sub




    Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim aw
    If Not ThisWorkbook.Saved Then
      aw = MsgBox("Sollen ihre Änderungen in " & ThisWorkbook.Name & " gespeichert werden?", vbExclamation + vbYesNoCancel)
      If aw = vbYes Then
        Sheets("ANALYSE").Activate
        MappeSpeichern
      ElseIf aw = vbNo Then
        Sheets("ANALYSE").Activate
        ThisWorkbook.Saved = True
      Else
        Cancel = True
      End If
    Else
      Sheets("ANALYSE").Activate
    End If

    End Sub




    Private Sub Workbook_Deactivate()
    Application.OnKey "^{F12}"
    End Sub





    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Cancel = True
    If SaveAsUI Then
      MsgBox "Datei kann nicht unter anderem Namen gespeichert werden!"
      Exit Sub
    End If

    ThisWorkbook.Saved = MappeSpeichern

    End Sub




    Private Sub Workbook_Open()
    Dim sh As Worksheet
    Dim ok As Boolean
    Dim Meldung As String

    ThisWorkbook.IsAddin = True

    'Lizenz prüfen:
    ok = False
    If SerienNr_Blatt = "" Then
      'noch nicht lizensiert:
      If Datum_Blatt = "" Then Set_Datum_Blatt Date
      If Date > CDate(Datum_Blatt) Then
        'zu spät!
        Meldung = "Die Lizensierungsmöglichkeit ist abgelaufen!" & vbLf & _
          "Bitte wenden Sie sich an ...."
      Else
        'Programm lizensieren
        Set_SerienNr_Blatt SerienNummer
        Set_Datum_Blatt FormatDateTime(Date, vbShortDate)
        Application.EnableEvents = False
        ThisWorkbook.Save
        Application.EnableEvents = True
        ok = True
        'Meldung = "Das Programm wurde soeben für Ihren Rechner lizensiert." & vbLf & _
          "Viel Spaß!"

      End If
    Else
      'schon lizensiert:
      If SerienNr_Blatt <> SerienNummer Then
        'falsche Festplatten-ID
        Meldung = "Das Programm für auf einem anderen PC lizensiert." & vbLf & _
          "Vielleicht haben Sie auch die Festplatte gewechselt." & vbLf & vbLf & _
          "Bitte wenden Sie sich an ...."
      Else
        ok = True
      End If
    End If

    'If Not ok Then ActiveWindow.Visible = False

    If Meldung <> "" Then
      Application.EnableCancelKey = xlDisabled
      MsgBox Meldung
      Application.EnableCancelKey = xlInterrupt
    End If

    ThisWorkbook.IsAddin = False

    If Not ok Then
      ThisWorkbook.Close False
      Exit Sub
    End If

    'Alle Blätter einblenden
    For Each sh In Worksheets
      If sh.Name <> MakroBlatt Then
        sh.Visible = True
      End If
    Next sh
    'Infoblatt ausblenden
    Sheets(MakroBlatt).Visible = xlSheetVeryHidden

    ThisWorkbook.Saved = True
    End Sub


    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    AW: Ansicht erste Tabelle...
    Joachim

    Hallo Sepp,
    zunächst - klappt es.....
    aber nur beim ersten Mal - nach dem ich eine -unregistrierte- Mappe das erste Mal aufrufe. Dann erscheint wirklich Tabelle 1 als erstes Blatt.
    Wenn anschließend diese Mappe erneut aufgerufen wird, -nachdem sie für den Rechner registriert wurde-, erscheint auch wieder die Tabelle 1 als erstes Blatt.
    Sobald ich jedoch die Mappe einmal gespeíchert habe (nachdem sie registriert wurde) erscheint immer die Tabelle 5 als erstes (aktives) Blatt.
    Es scheint wohl ein Wurm darin zu sein. Auch auf einem anderen Rechner ist es das Gleiche. Ich habe dies ausprobiert, da du ja mal sagtest, dass mein System -bockig- ist.
    Daran kann es also nicht liegen.
    Vielleicht schaust du bitte nocheinmal in den Code - evt. findest du noch eine Lösung, ansonsten muss ich eben damit leben.
    Viele liebe Grüße
    Joachim
    AW: Ansicht erste Tabelle...
    Josef

    Hallo Joachim!
    Was passiert in "MappeSpeichern" ?
    Du könntest auch im "Workbook_Open", nach der Zeile
    
    ThisWorkbook.IsAddin = True
    

    noch
    
    Sheets("ANALYSE").Activate
    

    Einfügen
    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    AW: Ansicht erste Tabelle...
    Joachim

    Hallo Sepp,
    das war es wohl..
    Nun klappt es!!
    Hurra...!!!!
    Nochmals vielen Dank für deine wertvolle Hilfe.
    Excel kann einen schon begeistern!
    Ich werde mich mit den unglaublichen Möglichkeiten von der VBA Programmierung nun
    intensiv auseinandersetzen.
    Man kann ja wohl mit Excel sogar auf dem Mond landen.... ;-)).
    Werde nun alles nochmal auf Herz und Nieren testen.
    --------------
    Bringt es etwas für die -Sicherheit ;-) - wenn man die Passwörter im HexFormat eingibt?
    oder ist das -Removing- damit genauso einfach?
    Geht dies überhaupt?
    -------------------
    Bei meinen Webseiten mach ich dies immer mit meinen mailadressen die im HTML-Code stehen. Seitdem habe ich nicht mehr soviel Ärger mit SPAM. Ja sogar die Adreesen die ich im HexCode eingeben habe sind noch nie in irgendwelchen Spamlisten aufgetaucht.
    Ist nur so eine Idee, um Crackern zumidest die Arbeit zu erschweren.
    --------------------
    Gibt es Begrenzungen bezgl. der Länge von Passwörtern für die jeweiligen Bereiche:
    Blattschutz - Arbeitsmappenschutz - VBA-Projekte?
    --------------------
    Alles Gute
    Joachim
    AW: Ansicht erste Tabelle...
    Josef

    Hallo Joachim!
    Ob Passwörter im Hex-Format akzeptiert werden weis ich nicht, glaube aber
    das der Schutz gleich leicht/schwer geknackt werden kann!
    Die maximale Länge der Passwörter beträgt beim Blatt- und Arbeitsmappen-Schutz 255 Zeichen, beim VBA-Projekt 32 Zeichen.
    Gruß Sepp
    AW: Ansicht erste Tabelle...
    Joachim

    Hallo Sepp,
    habs mir gedacht - war auch nur so eine Idee...
    -----------------
    Nun habe ich in einem anderen Thread von HansHei den Tipp gesehen die Menüleiste auszublenden - habe dies ebenfalls eingebaut - Funktioniert perfekt.
    ----------------
    Zur Abrundung: wie sehen die Codes für die Zeilen- und Spaltenüberschriften und die Bearbeitungszeile aus?
    Wenn ich dies ebenfalls mit einbinde - habe ich erstens eine größere Arbeitsfläche und ausserdem eine weitere Manipulationsmöglichkeit ausgeschaltet, da ich ja an keinen Menüpunkt mehr gelange.
    -------------------
    Meinen Code für die Menüabschaltung habe ich wie folgt integriert:
    Modul4 angelegt.
    Inhalt:
    Sub Einblenden()
    Dim cb As CommandBar
    For Each cb In Application.CommandBars
    cb.Enabled = True
    Next
    End Sub
    Sub Ausblenden()
    Dim cb As CommandBar
    For Each cb In Application.CommandBars
    cb.Enabled = False
    Next
    End Sub
    Dann in der Arbeitsmappe:
    1stens.
    
    Private Sub Workbook_Activate()
    Ausblenden ...............................eingefügt
    Application.OnKey "^{F12}", "AdminMode"
    End Sub
    

    2tens
    
    Private Sub Workbook_Deactivate()
    Einblenden................................eingefügt
    Application.OnKey "^{F12}"
    End Sub
    

    -----------------
    Gruß
    Joachim
    AW: Ansicht erste Tabelle...
    Josef

    Hallo Joachim!
    Dazu musst du noch folgendes einfügen1
    Private Sub Workbook_Activate()

    Application.DisplayFormulaBar = False

    End Sub


    Private Sub Workbook_Deactivate()

    Application.DisplayFormulaBar = True
    ActiveWindow.DisplayHeadings = True

    End Sub



    'Die Zeilen- und Spaltenbeschriftung bezieht sich immer auf das aktive Fenster
    Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    ActiveWindow.DisplayHeadings = False
    End Sub


    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    AW: Ansicht Mappen...
    Joachim

    Hallo Sepp,
    super - klappt hervorragend, aber...
    nun hab eich etwas damit angestellt.
    Selbst wenn ich nun eine andere Mappe öffne sind das Menür - die Zeilen- und Spaltenüberschriften und die Bearbeitungszeile deaktiviert....
    Wie bekomme ich dies nun wieder hin?
    Wird Excel mit diesen Codes grundsätzlich nun so eingestellt?
    Für alle anderen Mappen und Blätter sollten aber die Standardeinstellungen - wie sie in den Einstellungsoptionen vorgegeben wurden nicht verändert werden /sein.
    Gruß
    Joachim
    AW: Ansicht Mappen...
    Josef

    Hallo Joachim!
    Wenn du die Codes für die Menüs und die FormulaBar im richtigen Ereignis stehen hast,
    dann werden sie auch aus/eingeblendet!
    Die Zeilen und Spaltenbeschriftung bezieht sich, wie gesagt, immer auf das aktive
    Fenster. Mann kann es also nicht einer Tabelle oder Mappe zuweisen. Ich würde darauf verzichten!
    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    Zeilen- Spalten ect. ausblenden....?
    Joachim

    Hallo Sepp,
    mal wieder besser hier weiter.
    ---------------------------------
    Warum weiss ich nicht - aber nu nist der Fehler weg. ......
    Es gibt leider ein kleines anderes Problem:
    Die speichern Funktion - Analyse als Bericht speichern unter geht nun nicht mehr.
    Trotz Eingabe werde ich zur Eingabe aufgefordert....?
    Beeinflusst sich dort nun etwas zum Nachteil?
    ------------------------------------------------------
    Die Tabelle 3 und die Tabelle 4 - möchte ich bei Bedarf ausdrucken können.
    Wenn nun das Menü verborgen ist - kann ich einfach einen Button mit der Beschriftung DRUCKEN auf den Seiten einbauen und auf diesen den Befehl Strg + P legen?
    Wie weise ich solch einem Steuerelement diesen Befehl zu?
    ----------------------------------
    Gruß
    Joachim
    Ansicht erste Tabelle...
    Joachim
    Hallo Sepp,
    super - das mit dem Sprung in Zelle E1 - Top Klappt..
    Mit dem Code für die Arbeitsmappe, habe ich ein Problem.
    Ich schicke die hier den gesamten Code für die Sektion ARBEITSMAPPE:
    Option Explicit
    
    Private Sub Workbook_Activate()
    Application.OnKey "^{F12}", "AdminMode"
    End Sub
    

    
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim aw
    If Not ThisWorkbook.Saved Then
    aw = MsgBox("Sollen ihre Änderungen in " & ThisWorkbook.Name & " gespeichert werden?", vbExclamation + vbYesNoCancel)
    If aw = vbYes Then MappeSpeichern
    If aw = vbNo Then ThisWorkbook.Saved = True
    If aw = vbCancel Then Cancel = True
    End If
    End Sub
    

    
    Private Sub Workbook_Deactivate()
    Application.OnKey "^{F12}"
    End Sub
    

    
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
    If SaveAsUI Then
    MsgBox "Datei kann nicht unter anderem Namen gespeichert werden!"
    Exit Sub
    End If
    ThisWorkbook.Saved = MappeSpeichern
    End Sub
    

    
    Private Sub Workbook_Open()
    Dim sh As Worksheet
    Dim ok As Boolean
    Dim Meldung As String
    ThisWorkbook.IsAddin = True
    'Lizenz prüfen:
    ok = False
    If SerienNr_Blatt = "" Then
    'noch nicht lizensiert:
    If Datum_Blatt = "" Then Set_Datum_Blatt Date
    If Date > CDate(Datum_Blatt) Then
    'zu spät!
    Meldung = "Die Lizensierungsmöglichkeit ist abgelaufen!" & vbLf & _
    "Bitte wenden Sie sich an ...."
    Else
    'Programm lizensieren
    Set_SerienNr_Blatt SerienNummer
    Set_Datum_Blatt FormatDateTime(Date, vbShortDate)
    Application.EnableEvents = False
    ThisWorkbook.Save
    Application.EnableEvents = True
    ok = True
    'Meldung = "Das Programm wurde soeben für Ihren Rechner lizensiert." & vbLf & _
    "Viel Spaß!"
    End If
    Else
    'schon lizensiert:
    If SerienNr_Blatt <> SerienNummer Then
    'falsche Festplatten-ID
    Meldung = "Das Programm für auf einem anderen PC lizensiert." & vbLf & _
    "Vielleicht haben Sie auch die Festplatte gewechselt." & vbLf & vbLf & _
    "Bitte wenden Sie sich an ...."
    Else
    ok = True
    End If
    End If
    'If Not ok Then ActiveWindow.Visible = False
    If Meldung <> "" Then
    Application.EnableCancelKey = xlDisabled
    MsgBox Meldung
    Application.EnableCancelKey = xlInterrupt
    End If
    ThisWorkbook.IsAddin = False
    If Not ok Then
    ThisWorkbook.Close False
    Exit Sub
    End If
    'Alle Blätter einblenden
    For Each sh In Worksheets
    If sh.Name <> MakroBlatt Then
    sh.Visible = True
    End If
    Next sh
    'Infoblatt ausblenden
    Sheets(MakroBlatt).Visible = xlSheetVeryHidden
    ThisWorkbook.Saved = True
    End Sub
    

    --------------------------
    Wo soll ich den zusätzlichen Code einbauen, da ja:
    
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    schon vorhanden ist. Komme dann natürlich auf eine Fehlermeldung
    Diese Arbeitsmappe ist als Excelobjekt definiert nicht als Modul.
    Gruß
    Joachim
    
    AW: Ansicht erste Tabelle...
    Josef
    Hallo Joachim!
    So sollte es klappen!
    ' **********************************************************************
    ' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
    ' **********************************************************************

    Option Explicit

    Private Sub Workbook_Activate()
    Application.OnKey "^{F12}", "AdminMode"
    End Sub




    Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim aw
    If Not ThisWorkbook.Saved Then
      aw = MsgBox("Sollen ihre Änderungen in " & ThisWorkbook.Name & " gespeichert werden?", vbExclamation + vbYesNoCancel)
      If aw = vbYes Then
        Sheets("ANALYSE").Activate
        MappeSpeichern
      ElseIf aw = vbNo Then
        Sheets("ANALYSE").Activate
        ThisWorkbook.Saved = True
      Else
        Cancel = True
      End If
    Else
      Sheets("ANALYSE").Activate
    End If

    End Sub




    Private Sub Workbook_Deactivate()
    Application.OnKey "^{F12}"
    End Sub





    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Cancel = True
    If SaveAsUI Then
      MsgBox "Datei kann nicht unter anderem Namen gespeichert werden!"
      Exit Sub
    End If

    ThisWorkbook.Saved = MappeSpeichern

    End Sub




    Private Sub Workbook_Open()
    Dim sh As Worksheet
    Dim ok As Boolean
    Dim Meldung As String

    ThisWorkbook.IsAddin = True

    'Lizenz prüfen:
    ok = False
    If SerienNr_Blatt = "" Then
      'noch nicht lizensiert:
      If Datum_Blatt = "" Then Set_Datum_Blatt Date
      If Date > CDate(Datum_Blatt) Then
        'zu spät!
        Meldung = "Die Lizensierungsmöglichkeit ist abgelaufen!" & vbLf & _
          "Bitte wenden Sie sich an ...."
      Else
        'Programm lizensieren
        Set_SerienNr_Blatt SerienNummer
        Set_Datum_Blatt FormatDateTime(Date, vbShortDate)
        Application.EnableEvents = False
        ThisWorkbook.Save
        Application.EnableEvents = True
        ok = True
        'Meldung = "Das Programm wurde soeben für Ihren Rechner lizensiert." & vbLf & _
          "Viel Spaß!"

      End If
    Else
      'schon lizensiert:
      If SerienNr_Blatt <> SerienNummer Then
        'falsche Festplatten-ID
        Meldung = "Das Programm für auf einem anderen PC lizensiert." & vbLf & _
          "Vielleicht haben Sie auch die Festplatte gewechselt." & vbLf & vbLf & _
          "Bitte wenden Sie sich an ...."
      Else
        ok = True
      End If
    End If

    'If Not ok Then ActiveWindow.Visible = False

    If Meldung <> "" Then
      Application.EnableCancelKey = xlDisabled
      MsgBox Meldung
      Application.EnableCancelKey = xlInterrupt
    End If

    ThisWorkbook.IsAddin = False

    If Not ok Then
      ThisWorkbook.Close False
      Exit Sub
    End If

    'Alle Blätter einblenden
    For Each sh In Worksheets
      If sh.Name <> MakroBlatt Then
        sh.Visible = True
      End If
    Next sh
    'Infoblatt ausblenden
    Sheets(MakroBlatt).Visible = xlSheetVeryHidden

    ThisWorkbook.Saved = True
    End Sub


    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    AW: Ansicht erste Tabelle...
    Joachim
    Hallo Sepp,
    zunächst - klappt es.....
    aber nur beim ersten Mal - nach dem ich eine -unregistrierte- Mappe das erste Mal aufrufe. Dann erscheint wirklich Tabelle 1 als erstes Blatt.
    Wenn anschließend diese Mappe erneut aufgerufen wird, -nachdem sie für den Rechner registriert wurde-, erscheint auch wieder die Tabelle 1 als erstes Blatt.
    Sobald ich jedoch die Mappe einmal gespeíchert habe (nachdem sie registriert wurde) erscheint immer die Tabelle 5 als erstes (aktives) Blatt.
    Es scheint wohl ein Wurm darin zu sein. Auch auf einem anderen Rechner ist es das Gleiche. Ich habe dies ausprobiert, da du ja mal sagtest, dass mein System -bockig- ist.
    Daran kann es also nicht liegen.
    Vielleicht schaust du bitte nocheinmal in den Code - evt. findest du noch eine Lösung, ansonsten muss ich eben damit leben.
    Viele liebe Grüße
    Joachim
    AW: Ansicht erste Tabelle...
    Josef
    Hallo Joachim!
    Was passiert in "MappeSpeichern" ?
    Du könntest auch im "Workbook_Open", nach der Zeile
    
    ThisWorkbook.IsAddin = True
    

    noch
    
    Sheets("ANALYSE").Activate
    

    Einfügen
    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    AW: Ansicht erste Tabelle...
    Joachim
    Hallo Sepp,
    das war es wohl..
    Nun klappt es!!
    Hurra...!!!!
    Nochmals vielen Dank für deine wertvolle Hilfe.
    Excel kann einen schon begeistern!
    Ich werde mich mit den unglaublichen Möglichkeiten von der VBA Programmierung nun
    intensiv auseinandersetzen.
    Man kann ja wohl mit Excel sogar auf dem Mond landen.... ;-)).
    Werde nun alles nochmal auf Herz und Nieren testen.
    --------------
    Bringt es etwas für die -Sicherheit ;-) - wenn man die Passwörter im HexFormat eingibt?
    oder ist das -Removing- damit genauso einfach?
    Geht dies überhaupt?
    -------------------
    Bei meinen Webseiten mach ich dies immer mit meinen mailadressen die im HTML-Code stehen. Seitdem habe ich nicht mehr soviel Ärger mit SPAM. Ja sogar die Adreesen die ich im HexCode eingeben habe sind noch nie in irgendwelchen Spamlisten aufgetaucht.
    Ist nur so eine Idee, um Crackern zumidest die Arbeit zu erschweren.
    --------------------
    Gibt es Begrenzungen bezgl. der Länge von Passwörtern für die jeweiligen Bereiche:
    Blattschutz - Arbeitsmappenschutz - VBA-Projekte?
    --------------------
    Alles Gute
    Joachim
    AW: Ansicht erste Tabelle...
    Josef
    Hallo Joachim!
    Ob Passwörter im Hex-Format akzeptiert werden weis ich nicht, glaube aber
    das der Schutz gleich leicht/schwer geknackt werden kann!
    Die maximale Länge der Passwörter beträgt beim Blatt- und Arbeitsmappen-Schutz 255 Zeichen, beim VBA-Projekt 32 Zeichen.
    Gruß Sepp
    AW: Ansicht erste Tabelle...
    Joachim
    Hallo Sepp,
    habs mir gedacht - war auch nur so eine Idee...
    -----------------
    Nun habe ich in einem anderen Thread von HansHei den Tipp gesehen die Menüleiste auszublenden - habe dies ebenfalls eingebaut - Funktioniert perfekt.
    ----------------
    Zur Abrundung: wie sehen die Codes für die Zeilen- und Spaltenüberschriften und die Bearbeitungszeile aus?
    Wenn ich dies ebenfalls mit einbinde - habe ich erstens eine größere Arbeitsfläche und ausserdem eine weitere Manipulationsmöglichkeit ausgeschaltet, da ich ja an keinen Menüpunkt mehr gelange.
    -------------------
    Meinen Code für die Menüabschaltung habe ich wie folgt integriert:
    Modul4 angelegt.
    Inhalt:
    Sub Einblenden()
    Dim cb As CommandBar
    For Each cb In Application.CommandBars
    cb.Enabled = True
    Next
    End Sub
    Sub Ausblenden()
    Dim cb As CommandBar
    For Each cb In Application.CommandBars
    cb.Enabled = False
    Next
    End Sub
    Dann in der Arbeitsmappe:
    1stens.
    
    Private Sub Workbook_Activate()
    Ausblenden ...............................eingefügt
    Application.OnKey "^{F12}", "AdminMode"
    End Sub
    

    2tens
    
    Private Sub Workbook_Deactivate()
    Einblenden................................eingefügt
    Application.OnKey "^{F12}"
    End Sub
    

    -----------------
    Gruß
    Joachim
    AW: Ansicht erste Tabelle...
    Josef
    Hallo Joachim!
    Dazu musst du noch folgendes einfügen1
    Private Sub Workbook_Activate()

    Application.DisplayFormulaBar = False

    End Sub


    Private Sub Workbook_Deactivate()

    Application.DisplayFormulaBar = True
    ActiveWindow.DisplayHeadings = True

    End Sub



    'Die Zeilen- und Spaltenbeschriftung bezieht sich immer auf das aktive Fenster
    Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    ActiveWindow.DisplayHeadings = False
    End Sub


    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    AW: Ansicht Mappen...
    Joachim
    Hallo Sepp,
    super - klappt hervorragend, aber...
    nun hab eich etwas damit angestellt.
    Selbst wenn ich nun eine andere Mappe öffne sind das Menür - die Zeilen- und Spaltenüberschriften und die Bearbeitungszeile deaktiviert....
    Wie bekomme ich dies nun wieder hin?
    Wird Excel mit diesen Codes grundsätzlich nun so eingestellt?
    Für alle anderen Mappen und Blätter sollten aber die Standardeinstellungen - wie sie in den Einstellungsoptionen vorgegeben wurden nicht verändert werden /sein.
    Gruß
    Joachim
    AW: Ansicht Mappen...
    Josef
    Hallo Joachim!
    Wenn du die Codes für die Menüs und die FormulaBar im richtigen Ereignis stehen hast,
    dann werden sie auch aus/eingeblendet!
    Die Zeilen und Spaltenbeschriftung bezieht sich, wie gesagt, immer auf das aktive
    Fenster. Mann kann es also nicht einer Tabelle oder Mappe zuweisen. Ich würde darauf verzichten!
    '******************************
    '* Gruß Sepp
    '*
    '* Rückmeldung wäre nett!
    '******************************

    Zeilen- Spalten ect. ausblenden....?
    Joachim
    Hallo Sepp,
    mal wieder besser hier weiter.
    ---------------------------------
    Warum weiss ich nicht - aber nu nist der Fehler weg. ......
    Es gibt leider ein kleines anderes Problem:
    Die speichern Funktion - Analyse als Bericht speichern unter geht nun nicht mehr.
    Trotz Eingabe werde ich zur Eingabe aufgefordert....?
    Beeinflusst sich dort nun etwas zum Nachteil?
    ------------------------------------------------------
    Die Tabelle 3 und die Tabelle 4 - möchte ich bei Bedarf ausdrucken können.
    Wenn nun das Menü verborgen ist - kann ich einfach einen Button mit der Beschriftung DRUCKEN auf den Seiten einbauen und auf diesen den Befehl Strg + P legen?
    Wie weise ich solch einem Steuerelement diesen Befehl zu?
    ----------------------------------
    Gruß
    Joachim

    301 Forumthreads zu ähnlichen Themen


    Hallo,
    ich möchte ein einzelnes Tabellenblatt unter den Blattnamen und den Wert aus der Zelle B11 im Tabellenblatt "Eingabe" abspeichern. Die Zelle B11 habe ich mit einen Namen (Lieferung) definiert.
    Wie muß der VBA-Code dafür aussehen?
    Vielen Dank schon mal für Eure Hilfe.
    Gruß...
    Anzeige

    Ich habe folgendes Problem, ich möchte ein einzelnes Tabellenblatt aus Excel heraus in eine Pdf Datei mittels command Buttom und Makro/ VBA speichern. Als PDF Prog nutze ich Adobe Acrobat Prof 8.0(bringt nen Converter mit).
    THX im Voraus

    Hallo zusammen,
    ich bekomme seit Neuestem beim Speichern einer Datei (mittels VBA) manchmal eine Fehlermeldung. Ich habe zwar schon im Archiv gesucht, aber nix gefunden. Wahrscheinlich liegt's an meinen Suchbegriffen, denn ich hab die Fehlermeldung noch nie vorher gesehen und weiß nicht, wi...
    Anzeige

    Hey !
    Da eine meiner Arbeitsmappe immer mehr Arbeitsblätter (Tabellen) bekommt. Möchte ich diese irgendwie ausgliedern und nur bei bedarf wieder reinladen.
    Kann ich das irgend wie per Marko oder zu Fuß erledigen?
    Das heißt unter ihrem Namen ablegen. Und irgendwie (per extra Menüpunk...

    Hi,
    Hoffe mal wieder auf Eure Hilfe: Wie kann ich denn per Makro in meiner XLS das Sheet "Ablage" kopieren und im gleichen sheet unter dem Name "Data" wieder einfügen ?
    Danke
    mandy

    Guten Tag
    Gelegentlich wähle ich in einer Arbeitsmappe gleichzeitig mehrere Tabellen an, wenn ich beispielsweise bei allen die gleichen Änderungen durchführen will.
    Nun habe ich mir eine Routine geschrieben, die auf allen Tabellen ein Passwort setzt oder entfernt.
    Diese Routine läuf...
    Anzeige

    Links zu Excel-Dialogen

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige