Microsoft Excel

Herbers Excel/VBA-Archiv

Duplikate aus Datei erstellen benennen und sperren

Betrifft: Duplikate aus Datei erstellen benennen und sperren von: Blume
Geschrieben am: 02.09.2020 11:22:27

Hallo zusammen,


ich habe folgendes Anliegen (zu dem ich auch gern eine Beispieldatei erstellen kann, falls meine Beschreibung noch zu uneindeutig sein sollte).

Auf Sheet1 habe ich die Funktion, dass es mir über eine Dropdownliste nur die Kunden von dem jeweiligen Mitarbeiterkürzel anzeigt.

In Sheet2 habe ich eine Liste mit allen Kürzeln der Mitarbeiter.

Besteht die Möglichkeit aus dieser sogenannten Masterdatei Duplikate zu machen, die man dann mit Kürzel aus Sheet2 Spalte F benennt? und eventuell noch den Ort/Pfad per inputbox festlegen kann, wohin es diese ganzen Dateien speichern soll (ca. 20 Stück)?

Bevor man diese Dateien vervielfältigen würde, könnte man dann noch aus dem Sheet2 Spalte F das Kürzel an eine bestimmte Position in Sheet1 (Sheet1 D2) fügen und dann diese Zelle zu sperren, damit jeder Mitarbeiter nur seine Kunden sehen kann.

Geht das?


LG und schonmal Danke

Betrifft: AW: Duplikate aus Datei erstellen benennen und sperren
von: fcs
Geschrieben am: 02.09.2020 23:15:38

Hallo Blume,

hier ein Makro-Beispiel.

LG
Franz
Sub MA_Dateien_speichern()
  Dim strName As String, varOrdner, varDateixlsm, varDateixlsx
  Dim zeile As Long
  Dim wkb As Workbook
  Dim wkbMA As Workbook
  
  Set wkb = ActiveWorkbook
  
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Bitte Ordner für zu erstellende Dateien auswählen/erstellen"
    If .Show = -1 Then
      varOrdner = .SelectedItems(1)
    Else
      Exit Sub
    End If
  End With
  
  With wkb.Worksheets(2)
    'Kürzel-Liste abarbeiten
    For zeile = 2 To .Cells(.Rows.Count, 6).End(xlUp).Row 'startzeile ggf. anpassen.
      strName = .Cells(zeile, 6).Text
      varDateixlsm = varOrdner & Application.PathSeparator & strName & ".xlsm"
      varDateixlsx = varOrdner & Application.PathSeparator & strName & ".xlsx"
      If wkb.FileFormat = 52 Then 'xlOpenXMLTemplateMacroEnabled
        'Datei ist Datei mit Makros
        wkb.SaveCopyAs varDateixlsm
        Set wkbMA = Application.Workbooks.Open(varDateixlsm)
        With wkbMA.Worksheets(1)
          .Range("D2").Value = strName
          .Calculate
          .Cells.Locked = True
          .Protect Password:="Test"
        End With
        Application.DisplayAlerts = False
        wkbMA.SaveAs varDateixlsx, FileFormat:=51
        Application.DisplayAlerts = True
        wkbMA.Close savechanges:=True
        VBA.Kill varDateixlsm
      Else
        'Datei hat keine Makros
        wkb.SaveCopyAs varDateixlsx
        Set wkbMA = Application.Workbooks.Open(varDateixlsx)
        With wkbMA.Worksheets(1)
          .Range("D2").Value = strName
          .Calculate
          .Cells.Locked = True
          .Protect Password:="Test"
        End With
        wkbMA.Save
        wkbMA.Close savechanges:=True
      End If
    Next
  End With
  
End Sub


Betrifft: AW: Duplikate aus Datei erstellen benennen und sperren
von: Blume
Geschrieben am: 03.09.2020 10:27:10

Hallo Franz,

toller Code!
Das einzige Problem ist, dass es nicht das ganze Blatt sperren soll, sondern nur die Zellen die auch in der Masterdatei gesperrt sind, kann man diese Einstellung übernehmen? Geht das?

Betrifft: AW: Duplikate aus Datei erstellen benennen und sperren
von: fcs
Geschrieben am: 03.09.2020 10:32:52

Hallo Blume,

lösche die beiden Zeilen
          .Cells.Locked = True

Dann bleiben die geschützten Zellen unverändert .

LG
Franz

Betrifft: AW: Duplikate aus Datei erstellen benennen und sperren
von: Blume
Geschrieben am: 03.09.2020 10:46:05

Hallo Franz,

super, es klappt, würde jetzt noch die Möglichkeit bestehen, dass man die Zelle D2 immer entsperrt, damit dort die Kürzel aus Worksheet2 übernommen werden können, aber dann vor dem Speichern als eigene Datei wieder zu sperren? Dabei geht es nur um diese eine Zelle, damit man verhindert ein anderes Kürzel reinschreiben zu können.

Betrifft: AW: Duplikate aus Datei erstellen benennen und sperren
von: Blume
Geschrieben am: 03.09.2020 10:56:46

Hallo Franz,

jetzt ist mir noch aufgefallen, dass meine Schaltflächen ja immer noch verknüpft werden müsste, bevor man sie in den Duplizierten Dateien verwenden kann - gibt es da noch eine Möglichkeit, dies in den Code einzubinden, dass auch die Schaltflächen ihre Funktionen behalten?

Betrifft: AW: Duplikate aus Datei erstellen benennen und sperren
von: Blume
Geschrieben am: 03.09.2020 13:02:40

Hallo Franz,

jetzt ist mir noch aufgefallen, dass meine Schaltflächen ja immer noch verknüpft werden müsste, bevor man sie in den Duplizierten Dateien verwenden kann - gibt es da noch eine Möglichkeit, dies in den Code einzubinden, dass auch die Schaltflächen ihre Funktionen behalten?

Betrifft: AW: Duplikate aus Datei erstellen benennen und sperren
von: fcs
Geschrieben am: 03.09.2020 15:52:06

Hallo Blume,

wenn die Datei in dem gleichen Dateiformat gespeichert werden soll wie die Original-Datei, dann vereinfacht sich das Makro.

Falls in deiner Original-Datei der Blattschutz für das 1. Tabellenblatt aktiv ist, dann muss im Makro der Blattschutz deaktiviert werden - ggf. mit Passwort -, bevor die Zelle D2 ausgefüllt und ihr Schutz aktiviert wird.

LG
Franz
Sub MA_Dateien_speichern()
  Dim strName As String, varOrdner, varDatei, strExt As String
  Dim zeile As Long
  Dim wkb As Workbook
  Dim wkbMA As Workbook
  
  Set wkb = ActiveWorkbook
  strExt = Mid(wkb.Name, InStrRev(wkb.Name, "."))
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Bitte Ordner für zu erstellende Dateien auswählen/erstellen"
    If .Show = -1 Then
      varOrdner = .SelectedItems(1)
    Else
      Exit Sub
    End If
  End With
  
  With wkb.Worksheets(2)
    'Kürzel-Liste abarbeiten
    For zeile = 2 To .Cells(.Rows.Count, 6).End(xlUp).Row 'Startzeile ggf. anpassen.
        strName = .Cells(zeile, 6).Text
        varDatei = varOrdner & Application.PathSeparator & strName & strExt
        wkb.SaveCopyAs varDatei
        Set wkbMA = Application.Workbooks.Open(varDatei)
        With wkbMA.Worksheets(1)
          .Unprotect Password:="Test" 'Wenn Blatt in Mappe per Passwort geschützt ist, sonst  _
Passwort weglassen
          With .Range("D2")
            .Value = strName
            .Locked = True
          End With
          .Calculate
          .Protect Password:="Test"
        End With
        wkbMA.Close savechanges:=True
    Next
  End With
  
End Sub


Betrifft: AW: Duplikate aus Datei erstellen benennen und sperren
von: Blume
Geschrieben am: 03.09.2020 17:03:48

Ok, super, danke für den Hinweis!

Beiträge aus dem Excel-Forum zum Thema "Duplikate aus Datei erstellen benennen und sperren"