Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1376to1380
1376to1380
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Änderung VBA Code

Forumthread: Änderung VBA Code

Änderung VBA Code
17.08.2014 06:53:24
Bernd
Wunderschönen guten morgen liebe Excelgemeinde!
Mir wurde hier bereits super geholfen durch Sergej, Oberschlumpf und vielen anderen. Nochmals Tausend Dank dafür. Deshalb ist auch der VBA Code in meiner Beispieldatei von hier.
Bin damit sehr sehr glücklich, hätte da aber dennoch einen kleinen Wunsch bzw. Bitte, ob mir jemand weiter helfen könnte.
Habe alle Tips und Codes in meine Exceldatei eigearbeitet und dachte mir, ob es denn nicht möglich sei, aufgrund dieses Codes so eine Art Seitenanzahl, die sich jedoch leider ändern kann, einzubauen.
Meine VBA Kentnisse reichen dafür leider nicht aus bzw. weiß ich gar nicht, ob es denn überhaupt machbar ist?
Hier mal meine Beispieldatei mit einer exakten Beschreibung meines Anliegens:
https://www.herber.de/bbs/user/92153.xlsm
Hoffe ich habe mich Verständlich ausgedrückt, wünsche noch einen schönen Sonntag und verbleibe mit freundlichen Grüßen,
Bernd

Anzeige

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Änderung VBA Code
17.08.2014 07:35:20
Crazy
Hallo Bernd
sieht zwar nicht ganz sauber aus, erfüllt aber seinen Zweck 
    Dim i As Integer
For i = 1 To Worksheets.Count
Cells(i + 2, 2) = Sheets(i).Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 2, 2), Address:="", SubAddress:= _
"'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
ActiveWorkbook.Sheets(i).Cells(2, 2).Value = Sheets(i).Index - 1
Sheets("01. Übersichtsliste").Range("A3").Clear
Sheets("01. Übersichtsliste").Range("B2").Clear
Cells(i + 2, 1) = Sheets(i).Cells(2, 2).Value
Next 'i

MfG Tom

Anzeige
AW: Änderung VBA Code
17.08.2014 08:41:50
Bernd
Hallo Tom!
Danke funktioniert Ausgezeichnet.
Hab leider vorhin vergessen auf meinen 4. Punkt.
Ich würde nun gerne, die automatisch generierte Zahl als Seitennummer
unten Rechts (Fußzeile) einfügen.
Wie muss ich das anstellen?
lg und Danke für Deine Mühen,
Bernd

Anzeige
noch ein Vorschlag
17.08.2014 09:01:38
Erich
Hi Bernd,
noch ein Codevorschlag (noch ohne 4.): 

Option Explicit                        ' IMMER zu empfehlen
Sub sbName()
Dim strN As String
Dim X As Integer
Dim Y As Integer
Dim i As Integer
'  Application.ScreenUpdating = False     ' evtl. NACH dem Test aktivieren
With Sheets("01. Übersichtsliste")
.Unprotect
For X = 1 To Worksheets.Count - 1
For Y = X + 1 To Worksheets.Count
If Worksheets(Y).Name  strN Then
Worksheets(i).Cells(2, 2).Value = i - 1
.Cells(i + 2, 1) = i - 1
End If
Next i
With .Columns("A:A").Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
.Columns("A:A").EntireColumn.AutoFit
Application.GoTo Reference:="R3C1"
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
Application.ScreenUpdating = True
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: noch ein Vorschlag
17.08.2014 09:08:54
Bernd
Hallo Erich!
Danke Dir für Deinen Vorschlag. Da ja mein VBA Wissen nur begrenzt ist, muss ich sagen, es funktioniert auch Deine Lösung bestens.
Um aber keinen von Euch beiden zu Beleidigen, verrate ich nicht, welche Version ich nun Verwende :-)
Trotzdem vielen lieben Dank vorerst, und hoffe, auch für meinen 4. Wunsch gibt es eine Lösung.
lg Bernd

Anzeige
und zu 4.
19.08.2014 09:02:38
Erich
Hi Bernd,
... gibt es auch eine Lösung: 

Option Explicit                        ' IMMER zu empfehlen
Sub sbName()
Dim strN As String, X As Long, Y As Long, i As Long
'  Application.ScreenUpdating = False     ' evtl. NACH dem Test aktivieren
With Sheets("01. Übersichtsliste")
.Unprotect
For X = 1 To Worksheets.Count - 1
For Y = X + 1 To Worksheets.Count
If Worksheets(Y).Name  strN Then
.Cells(i + 2, 1) = i - 1
Worksheets(i).Cells(2, 2).Value = i - 1
Worksheets(i).PageSetup.RightFooter = CStr(i - 1)
End If
Next i
.Columns("A:A").EntireColumn.AutoFit
Application.PrintCommunication = True
Application.GoTo Reference:="R3C1"
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
Application.ScreenUpdating = True
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: und zu 4. --> Bingo
19.08.2014 19:48:06
Bernd
Hallo Erich !
Ich Danke Dir von ganzem Herzen, der Wahnsinn, wie Du mir geholfen hast.
Hab ja nicht mehr an eine Lösung gedacht. Denn während des Wartens habe ich Stunden damit verbracht,
zigtausend Vorschläge anderer zu Testen, natürlich ohne Erfolg.
Aber jetzt funzt es ja so wie ich es wollte.
Nochmals recht herzlichen Dank, viele liebe Grüße, aus dem verregneten Klagenfurt am Wörthersee, nach Kamp-Lintfort, an Dich und Deinen nächsten.
lg Bernd

Anzeige
AW: Änderung VBA Code
17.08.2014 20:55:35
Adis
Hallo
vieles ist machbar , probier es einfach aus. Lege ein zweites Modulblatt als Kopie an (zur Vorsicht)
und kopiere das geäenderte Makro ins Modublatt1. Ich habe es getestet, müsste funktionieren.
Die Änderung wurde von mir mit Kommentar dokumentiert, damit man verstehen kann was passiert.
Einige Programmteile sind überflüssig, dann habe ich es mit Kommentar versehen. Viel Spass beim Test.
Sub sbName() 'geäendert von Adis  17.8.2014 für Herber Forum
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Dim WS As Worksheet
Dim X As Integer
Dim Y As Integer
Set WS = ActiveSheet
For X = 1 To ActiveWorkbook.Worksheets.Count
For Y = X To ActiveWorkbook.Worksheets.Count
If Worksheets(Y).Name  1 Then  '1. Blatt Übersichtliste nicht ausfüllen
Sheets(i).Cells(2, 2) = i - 1    'Zelle B2 aendern
Sheets(i).Cells(1, 1) = Sheets(i).Name & " " & i - 1
End If
'Cells(1+2, 1-2)  1 und 2 nur umgetauscht
Cells(i + 2, 2) = Sheets(i).Name
Cells(i + 2, 1) = Sheets(i).Cells(2, 2).Value
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 2, 2), Address:="", SubAddress:= _
"'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
Next 'i
'kann entfallen (oder gekürzt werden) weil Spalte B bereits formatiert ist
'(ist nur sinnvoll als Makro Recorder Aufzeichnung) beim 1. Installieren!)
Columns("B:B").Select
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False   'ab hier kann alles entfallen
.Superscript = False     '(Makro Recorder Aufzeichnung)
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
'auf Spalte B geaendert
Columns("B:B").EntireColumn.AutoFit
Application.ScreenUpdating = True
Application.GoTo Reference:="R3C1"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Sub Löschen()
' Löschen Makro
ActiveSheet.Unprotect
Range("A2:G272").ClearContents   '(ohne Selection...)
Range("A4").Select  'auf A4 gesetzt statt C4
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Gruss Adis

Anzeige
AW: Änderung VBA Code
18.08.2014 04:18:45
Bernd
Hallo Adis!
Erstmal sage ich Danke für Deine Hilfe. Leider ist es so, wenn ich Deinen Code verwende, spielen sich seltsame Dinge ab.
Meine Musterdatei ist nur ähnlich aufgebaut, die Originale hat auch zB.: einen Makro VBA Code wo ich ein Tabellenblat kopiere, dieses wird nun automatisch umgeschrieben.
In der Verbundenen Zelle A1 wird mein Name um eine Nummer erweitert, zB.: von Muster auf Muster1, Test auf Test2 usw.
Und, wenn ich auf Druckansicht gehe, ist keine Seitennummer, als Fußzeile rechts, vorhanden.
Der Code von den beiden Ersthelfern funktioniert einwandfrei, es fehlt nur noch, dass eben die Seitennummer mit ausgedruckt wird.
Trotzdem nochmlas Danke für Deine Hilfe.
lg Bernd
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige