Hallo Liebe Excel Experten,
unter dem folgenden Link findet ihr mein aktuelles Projekt.
Die Erfassung aktueller Aufträge in einer Auftragsliste.
Mein Problem ist, wenn ich eine Auftragsnummer bearbeite und dieser Inhalt gebe und diesen über eine UserForm an die Tabelle übergebe,
so wird die aktuelle Formartierung in der Tabelle überschrieben.
Meine Frage ist:
Wie kann ich dem aktiven Datensatz bei Übergabe der Daten an die Tabelle, die Formartierung der Tabelle übergeben.
Heißt wenn "A1" eine Schriftformartierung von "Bariol Regular, Schriftgröße: 12" hat soll "A2" nach Übergabe der Daten aus der UserForm
die gleiche Formartierung wie "A1" haben.
Link: auftragsliste-2
Aktueller Code zur Übergabe der Daten an die Tabelle so wie den Versuch die Formartierungen zu übernehmen:
Sub programmedit()
Dim intSpalte As Integer
Dim ctrTB As Control
Dim rngSucheTeil As Range
If uf_programm.tx_ocno.Value <> "" Then
With Tabelle2
Set rngSucheTeil = .Columns("A:Q").Find(uf_programm.tx_ocno, LookAt:=xlWhole, LookIn:=xlValues)
If Not rngSucheTeil Is Nothing Then
' Schleife über alle Steuerelemente
For Each ctrTB In uf_programm.Controls
' Tag-Eigenschaft ist nicht leer
If ctrTB.Tag <> "" Then
' in Zelle(gefundeneZeile, Spaltennummer aus Tag-Eigenschaft) aus Steuerelement übergeben
.Cells(rngSucheTeil.Row, Int(ctrTB.Tag)).Value = ctrTB
End If
Next ctrTB
Run "MachMal"
Else
MsgBox "Die Daten von """ & uf_programm.tx_ocno & """ wurden nicht gefunden!", 48, _
" Hinweis für " & Application.UserName
uf_programm.tx_ocno.SetFocus
End If
End With
Set rngSucheTeil = Nothing
End If
End Sub
Sub MachMal()
Dim ws As Worksheet, rg1 As Range, rg2 As Range
Dim n As Long
'hier den Tabellennamen anpassen
Set ws = ThisWorkbook.Worksheets("Tabelle2")
With ws
'Überschriften-Bereich definieren
Set rg1 = .Range("A3:Q3")
'neu zu formatierender Bereich mit Überschriften-Zellen
Set rg2 = .UsedRange
'zu formatierender Bereich ohne Überschriften-Zellen
Set rg2 = rg2.Offset(2).Resize(rg2.Rows.Count - 1)
End With
'Überschriften kopieren
rg1.Copy
'Format übertragen
rg2.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Kopierbereich deaktivieren
Application.CutCopyMode = False
'Markierung der formatierten Zellen deaktivieren
rg2.Cells(1, 1).Select
'Objektvariablen zerstören
Set rg1 = Nothing
Set rg2 = Nothing
Set ws = Nothing
End Sub
Vielen Dank im Voraus für eure Hilfe.
Gruß
Marius
|