AW: Öffnen von Dateien und aktivieren von Tabellen...
21.08.2003 11:29:03
Daniel G
Genau so mein ich das.
hier mal der ganze Code(aber vorsicht: Hitverdächtiges Gepfusche...)
Code:
Option Explicit
Private Sub Cmd1_Click()
Workbooks.Open FileName:="c:\eigene dateien\testmappeentw~1.xls"
End Sub
Private Sub CommandButton1_Click()
Dim z As Integer
Dim x As Integer
'Ändern der Beschriftung
CommandButton1.Caption = " Zeilenweises Ändern"
' Zeilenweises Ändern der Eigenschaften uns des Inhaltes per "Do...Loop Schleife"
x = 1
Do
'Tabelle 1 wird aktiviert und die Zeilen in Abhängigkeit von x gewählt
Sheets("Tabelle1").Select
Range(Cells(x, 1), Cells(x, 17)).Select
Selection.Copy
'Tabelle 2 wird aktiviert und die Zeilen, nummeriert in Abhängigkeit von x,
'mit den Formaten der entsprechenden Zellen aus Tabelle 1 formatiert
Sheets("tabelle2").Select
Tabelle2.Range(Tabelle2.Cells(x, 1), Tabelle2.Cells(x, 17)).Select
Selection.PasteSpecial Paste:=xlFormats
'Tabelle 1 wird aktiviert und die Zeilen in Abhängigkeit von x gewählt
Sheets("tabelle1").Select
Tabelle1.Range(Tabelle1.Cells(x, 1), Tabelle1.Cells(x, 17)).Select
Selection.Copy
'Tabelle 2 wird aktiviert und die Zeilen, nummeriert in Abhängigkeit von x,
'mit den Werten der entsprechenden Zellen aus Tabelle 1 gefüllt
Sheets("tabelle2").Select
Tabelle2.Range(Tabelle2.Cells(x, 1), Tabelle2.Cells(x, 17)).Select
Selection.PasteSpecial Paste:=xlValues
'Tabelle2 ist aktiv und Ihr werden fixe Spaltenbreiten zugewiesen
Sheets("Tabelle2").Range("A1").ColumnWidth = 7.43
Sheets("Tabelle2").Range("B1").ColumnWidth = 52.71
Sheets("Tabelle2").Range("C1").ColumnWidth = 19
Sheets("Tabelle2").Range("D1").ColumnWidth = 17.29
Sheets("Tabelle2").Range("E1").ColumnWidth = 20.71
Sheets("Tabelle2").Range("F1").ColumnWidth = 16.86
Sheets("Tabelle2").Range("G1").ColumnWidth = 35.14
Sheets("Tabelle2").Range("H1").ColumnWidth = 15.57
Sheets("Tabelle2").Range("I1").ColumnWidth = 14.29
Sheets("Tabelle2").Range("J1").ColumnWidth = 20.29
Sheets("Tabelle2").Range("K1").ColumnWidth = 19
Sheets("Tabelle2").Range("L1").ColumnWidth = 16.57
Sheets("Tabelle2").Range("M1").ColumnWidth = 18.86
Sheets("Tabelle2").Range("N1").ColumnWidth = 19
Sheets("Tabelle2").Range("O1").ColumnWidth = 19
Sheets("Tabelle2").Range("P1").ColumnWidth = 30.14
Sheets("Tabelle2").Range("Q1").ColumnWidth = 26
'Tabelle2 ist aktiv.
'Es werden den zu bearbeitenden Zellen
'Schriftgrösse, -art, -farbe, -ausrichtung zugewiesen
Tabelle2.Range(Tabelle2.Cells(x, 1), Tabelle2.Cells(x, 17)).Select
With Selection.Cells.Font
.Name = "Arial"
.Size = 8
.ColorIndex = 1
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
End With
' Alle Zeilen werden im Durchlauf, in Abhängigkeit von x, in der Breite optimiert
Columns("A:Q").EntireColumn.AutoFit
' Alle Zeilen werden im Durchlauf, in Abhängigkeit von x, in der Grösse ptimiert
Worksheets("Tabelle1").Range("Ax:Qx").Rows.AutoFit
'Wiederholung...
x = x + 1
Loop Until Tabelle1.Cells(x, 1) = ""
'Hyperlinks bzw. Formate vergleichen und Übernehmen
On Error Resume Next
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim WS3 As Worksheet
Dim Suche As String
Dim find As Variant
Dim I As Integer
Set WS1 = Worksheets("Tabelle1")
Set WS2 = Worksheets("Tabelle2")
Set WS3 = Worksheets("Tabelle3")
For I = 1 To 500 'Anzahl der Zeilen
Suche = WS2.Cells(I, 1) 'Suchbegriff aus Tabelle 2 / Spalte A
Set find = WS1.Range("A:A").find(Suche, LookIn:=xlValues) ' In Tabelle 1 / Spalte a suchen
WS2.Rows(find.Row).Format = WS1.Rows(I).Format ' wenn gefunden komplette Zeile von Tabelle 1 nach Tabelle 2 kopieren
Next I
End Sub
Hab da noch ein wenig Probs mit, geht aber eigentlich recht gut...
Is halt zusammen geflickt...
Gruss Daniel