Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1332to1336
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

überschrieft mit dokumentieren

überschrieft mit dokumentieren
14.10.2013 13:06:51
nou
Hallo leute mir wurde hier vor einigen wochen mit einem changelog seeehr seehr gut geholfen ich habe nun eine frage
meine tabelle hat 6 spalte ich möchte jetzt dass bei der dritten spalte wo ja immer das wieder geben wird was geändert wurde, dass da immer die überschrieft aus der ersten Zeile der ausgeählten spalte mit dokumentiert wird..
beispiel wenn das datum geändert wurde und in der zeile als überschrieft datium steht soll kommen :
Datum:xxxxxx und dann eben dr geänderte wert so dass min immer weis wo was verändert wurde un mit einem doppelpunkt damit die trennung klar ist.#
kann mir da jemand weiterhelfen? vielleicht reicht es ja wenn ich njur ein kommentar dazuschreibe
danke
Option Explicit
Dim lngRow As Long
Dim intYesNo As Integer
Dim strGrund As String
Dim strAlterWert As String
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
intYesNo = MsgBox("Möchten Sie die Änderung übernehmen?", vbYesNo, "Änderungsabfrage")
Select Case intYesNo
Case 6
Do
strGrund = InputBox("Bitte Änderungsgrund angeben", "Änderungsgrund")
Loop Until (strGrund  "") 'Eingabe erzwingen
' Changelog in Tabelle3 ausfuellen
With Worksheets("Tabelle3")
lngRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngRow, 1).Value = Target.Address(False, False)
.Cells(lngRow, 2).Value = Cells(Target.Row, 1).Value
.Cells(lngRow, 3).Value = strAlterWert
.Cells(lngRow, 4).Value = Target.Value
.Cells(lngRow, 5).Value = Application.UserName
.Cells(lngRow, 6).Value = Now
.Cells(lngRow, 7).Value = strGrund
End With
Case Else
'Falls bei der Abfrage "Nein" gewaehlt wird, wird der alte Wert wieder eingetragen ( _
Aenderung verworfen)
Application.EnableEvents = False
Target.Value = strAlterWert
Application.EnableEvents = True
Exit Sub
End Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Verhindern, dass mehr als eine Zelle selektiert wird
On Error GoTo ErrorExit
Application.EnableEvents = False
ActiveCell.Select
ErrExit:
Application.EnableEvents = True
'Wert der ausgewaehlten Zelle merken, um im Changelog den alten Zellwert zu dokumentieren
strAlterWert = Target.Value
ErrorExit:
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: überschrieft mit dokumentieren
14.10.2013 13:25:23
Bastian
Hallo nou,
du musst die entsprechende Codezeile wie folgt ändern:

.Cells(lngRow, 3).Value = Cells(1, Target.Column).Value & ": " & strAlterWert
Gruß, Bastian

AW: überschrieft mit dokumentieren
14.10.2013 13:43:10
nou
super vielen dank

AW: überschrieft mit dokumentieren
14.10.2013 15:10:30
nou
Bastian kannst du auch in Word mit Vba Programmieren?
Denn ich habe ein Word Tamplate das mit VBA auf excel zugreifen soll und es in word filtern und einfügen soll.
ich habe ein Word Tamplate in dem im 3.kapitel automatisiert wird.
das sieht dann so aus in der überschrieft muss mann manuell das release eingeben (Da wo ich xxxx habe)
3. Change history after last Release xxxxxxxxx
Spalte A Spalte B
Id (spalte a) F-name (spalte b)
Id (spalte a) F-name (spalte b)
Id (spalte a) F-name (spalte b)
Id (spalte a) F-name (spalte b)
Id (spalte a) F-name (spalte b)
Nun will ich dass man durch das eingeben des releases automatisch auf meine excel tabelle mit dem link ´´xxx´´ zugreift und hier nach dem entsprechenden release in spalte F filtert und alles was dabei in spalte A und B rauskommt soll in mein WOrd template eingefügt werden..
so ich habe da bereits ein bisschen rumprobiert..
Sub kopier_filterergebnis()
Dim excelinstanz As Object, excelmappe As Object, excelblatt As Object
Dim datei As String
Dim letztezeile As Integer
Dim zieldoku As Document
Dim feature As String
On Error GoTo fehler
'Feature-Namen abfragen
feature = InputBox("Bitte Feature-Namen eingeben", , "Feature 3")
'Objekte definieren(Zieldokument, Exceltabelle)
Set zieldoku = ActiveDocument
Set excelinstanz = CreateObject("Excel.application")
excelinstanz.Visible = True 'nur zum testen
datei = ThisDocument.Path & "\filtermappe.xlsm" 'anpassen*********
Set excelmappe = excelinstanz.workbooks.Open(FileName:=datei)
Set excelblatt = excelmappe.sheets("tabelle1") 'anpassen**********
'Exceltabelle nach Featurenamen in Spalte F filtern
excelblatt.UsedRange.AutoFilter Field:=6, Criteria1:=feature
'Filterergebnis nach Word kopieren
letztezeile = excelblatt.Cells(excelblatt.Rows.Count, 1).End(-4162).Row 'entspricht (xlUp)
excelblatt.Range("A2:B" & letztezeile).SpecialCells(12).Copy
zieldoku.Bookmarks("name_feature").Select
Selection = "Kapitel 3 enthält: " & feature & Chr(13)
Selection.Bookmarks.Add Name:="name_feature"
Selection.MoveDown unit:=wdLine
Selection.Paste
'Zum Schluss wird aufgeräumt:
excelmappe.Close savechanges:=False
excelinstanz.Quit
Set excelinstanz = Nothing
Set excelmappe = Nothing
Exit Sub
fehler: 'Fehlerkontrolle
MsgBox Err.Description & " - " & Err.Number
excelinstanz.Visible = True
Set excelinstanz = Nothing
Set excelmappe = Nothing
End Sub

Anzeige
Sorry, da kann ich nicht helfen oT
14.10.2013 20:47:44
Bastian
Gruß, Bastian

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige