mappe speichern

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: mappe speichern
von: Mario
Geschrieben am: 23.11.2003 23:09:17

Hallo zusammen

habe gleich mehrere Probleme.
Problem 1


Sub zelle_Mappe_dateiname()
Dim datname As String
Dim i As Integer
Dim h As String
Dim o As String
Dim uo As String
Dim uo1 As String
For i = 1 To 4
'Datei name
datname = Sheets("Tabelle1").Cells(i, 1).Value
h = Cells(2, 3).Value
o = Cells(2, 4).Value
uo = Cells(2, 5).Value
uo1 = Cells(2, 6).Value
'Next i
'Pfad
'Ich möchte nur Tabelle2 als Datei speichern,orginalmappe nicht schliessen
ActiveWorkbook.SaveAs h & ":\" & o & "\" & uo & "\" & uo1 & datname & ".xls"
Next i
ActiveWindow.Close
End Sub


2.Problem
Dieses Makro sucht nach einem begriff in einer arbeitsmappe.
Ich möchte nun eine Ordner durchsuchen und die gefundenen Dateien in Tabelle1
Spalte H ab Zelle2 als kompletten Pfad ausgeben.


Sub TextInArbeitsmappeSuchenUndKennzeichnen()
Dim s As String
Dim i As Integer
Dim Erg1 As Variant
Dim Erg2 As Variant
s = InputBox("Geben Sie den Suchbegriff ein!", "Textsuche")
If s = "" Then Exit Sub
For i = 1 To ActiveWorkbook.Sheets.Count
  Sheets(i).Activate
  Set Erg1 = Sheets(i).Cells.Find(s)
  If Not Erg1 Is Nothing Then
   Erg2 = Erg1.Address
    Do
      With Erg1
       .Activate
       .Interior.ColorIndex = 4
      End With
      Set Erg1 = Cells.FindNext(After:=ActiveCell)
      On Error Resume Next
      If Erg1.Address = Erg2 Then Exit Do
      Erg1.Interior.ColorIndex = 4
    Loop
  End If
Next i
End Sub


Vielen Dank im Voraus.

Gruss Mario
Bild


Betrifft: AW: mappe speichern
von: Nepumuk
Geschrieben am: 23.11.2003 23:29:49

Hallo Mario,
so funktioniert es mit dem speichern von Tabelle2:

Option Explicit
Sub zelle_Mappe_dateiname()
    Dim datname As String, i As Integer, h As String
    Dim o As String, uo As String, uo1 As String
    For i = 1 To 4
        datname = Sheets("Tabelle1").Cells(i, 1).Value
        h = Cells(2, 3).Value
        o = Cells(2, 4).Value
        uo = Cells(2, 5).Value
        uo1 = Cells(2, 6).Value
        Worksheets("Tabelle2").Copy
        With ActiveWorkbook
            .SaveAs h & ":\" & o & "\" & uo & "\" & uo1 & datname & ".xls"
            .Close
        End With
    Next i
End Sub


Code eingefügt mit: Excel Code Jeanie

Die zeite Frage beantworte ich heut nicht mehr, ich will ja heute noch ins Bett.
Gruß
Nepumuk


Bild


Betrifft: AW: mappe speichern
von: mario
Geschrieben am: 23.11.2003 23:42:50

Hallo,

vielen Dank für das schnelle Antworten.
Die Lösung für das erste Problem funktioniert bestens.

Danke.

Gruss Mario


Bild


Betrifft: AW: mappe speichern
von: Nepumuk
Geschrieben am: 24.11.2003 07:49:17

Hallo Mario,
da du nicht schreibst, ob die gefundenen Einträge markiert werden sollen, sowie du nicht schreibst, wie du den Ordner auswählen willst, habe ich mal das markieren dringelassen, sowie den Pfad als Pfad der Mappe in der das Programm steht genommen. Melde dich und schreib wie du es haben willst.
Gruß
Nepumuk


Bild


Betrifft: AW: mappe speichern
von: mario
Geschrieben am: 24.11.2003 19:41:03

Hallo zusammen,hallo Nepumuk

ich stelle mir das so vor.Ich habe eine sogenannte Vorlagemappe.
Mit dem ersten Makro wird das 2.Blatt gespeichert mit dem aus den
Variablen erstellt Pfad.
Den Ordner auswählen möchte ich aus den selben Variablen aus Makro1.Die gefundenen Einträge sollen markiert werden.Der Pfad soll in der Vorlagemappe Spalte H ab Zeile
stehen und schlussendlich als Hyperlink umgewandelt werden.
Ich habe noch dieses Makro hinzugefügt zu besserem Verständnis.



Sub DateienAuflisten_Hyperlink()
Dim i  As Long
Dim verz As String
Dim h As String
Dim o As String
Dim uo As String
Dim uo1 As String
Dim Bereich As Range
Dim Zelle As Range
h = Cells(2, 3).Value
o = Cells(2, 4).Value
uo = Cells(2, 5).Value
uo1 = Cells(2, 6).Value
verz = h & ":\" & o & "\" & uo & "\" & uo1
On Error GoTo fehler
ChDir verz
Range("H2").Select
With Application.FileSearch
    .NewSearch
    .LookIn = verz
    .SearchSubFolders = False
    .FileType = msoFileTypeExcelWorkbooks
    .Execute
    For i = 1 To .FoundFiles.Count
          ActiveCell.Offset(0, 1).Value = .FoundFiles(i)
        ActiveCell.Offset(1, 0).Select
    Next i
End With
'DateipfadInHyperlinksWandeln
Range("H2").Select
Do Until ActiveCell.Value = ""
ActiveCell.Hyperlinks.Add ActiveCell, ActiveCell.Value
  ActiveCell.Value = ActiveCell.Offset(1 - 1, 0 - 1)
  ActiveCell.Offset(1, 0).Select
Loop
Exit Sub
fehler:
MsgBox "Es gibt kein Verzeichnis mit dem Namen " & verz
End Sub


Vielen Dank

Gruss Mario


Bild

Beiträge aus den Excel-Beispielen zum Thema " mappe speichern"