Hallo Zusammen
Ich stehe an bei der Aktivierung von Textumbruch. Grundsätzlich läuft das Programm durch. Wollte zusätzlich noch innerhalb zwei Daten-Bereichen die Zellen mit Textumbruch aktivieren. Bei meinen bescheidenen VBA Kenntnissen hab ich nur "???" bezüglich der Fehlermeldung "Laufzeitenfehler 1004 Anwendungs-oder objektdefinierter Fehler".
Hoffe jemand von euch kann mir helfen.
Den Code hab ich angefügt die doppelt Auskommatierte Stelle macht Probleme.
Mit der Lösung erhoffe ich mir noch weiteren Punkte zu erledigen:
- Spaltenhöhe anpassen

Programm rufe ich mit UF auf und befülle eine Durckfertige Tabelle. Daraus erstelle ich eine PDF-Datei.
Beispieldatei: https://www.herber.de/bbs/user/167117.xlsm
---------------------------------------------------------------
Private Sub lblPrint_Click()
Dim wb As Workbook
Dim wsR, wsP, wsRef As Worksheet
Dim Druckbereich, Kopf, Daten, D, G As Range
Dim lzR, lsR, izE, lsE, Zähler, NBName, User, UserID, DBer, DKopf, DDaten, DD, DG, Per, Vor, Nach, Von, Bis As String
Dim i, k As Integer

Set wb = ThisWorkbook
Set wsR = wb.Worksheets("Records")
Set wsP = wb.Worksheets("Print")
Set wsRef = wb.Worksheets("References")

NBName = Environ("COMPUTERNAME")
UserID = Environ("USERNAME")
User = Application.UserName

wsRef.Cells(8, 12).Value = CDate(UfStart.tbVon.Text)
lzP = wsP.Cells(wsP.Rows.Count, 1).End(xlUp).Row
lsP = wsP.Cells(7, 256).End(xlToLeft).Column
lzR = wsR.Cells(wsR.Rows.Count, 1).End(xlUp).Row
lsR = wsR.Cells(4, 256).End(xlToLeft).Column
Zähler = lzP + 1

wsP.Cells(3, 3) = UfStart.tbPer
wsP.Cells(4, 3) = UfStart.tbVor
wsP.Cells(5, 3) = UfStart.tbNach
For i = 4 To lzR
If wsR.Cells(i, 8) >= wsRef.Cells(8, 12) And wsR.Cells(i, 8) = wsRef.Cells(8, 13) Then
wsP.Cells(Zähler, 1) = CDate(wsR.Cells(i, 8))
wsP.Cells(Zähler, 2) = wsR.Cells(i, 9)
wsP.Cells(Zähler, 3) = wsR.Cells(i, 10)
wsP.Cells(Zähler, 4) = wsR.Cells(i, 11)
wsP.Cells(Zähler, 5) = wsR.Cells(i, 12)
wsP.Cells(Zähler, 6) = wsR.Cells(i, 13)
wsP.Cells(Zähler, 7) = wsR.Cells(i, 6) & " / " & wsR.Cells(i, 7)
wsP.Cells(Zähler, 8) = wsR.Cells(i, 14)
wsP.Cells(Zähler, 9) = wsR.Cells(i, 15)
Zähler = Zähler + 1
End If
Next i

lzP = wsP.Cells(wsP.Rows.Count, 1).End(xlUp).Row
lsP = wsP.Cells(7, 256).End(xlToLeft).Column
Per = wsP.Cells(3, 3).Value
Vor = wsP.Cells(4, 3).Value
Nach = wsP.Cells(5, 3).Value
Von = UfStart.tbVon.Value
Bis = UfStart.tbBis.Value

Set Druckbereich = wsP.Range(wsP.Cells(1, 1), wsP.Cells(lzP, lsP)) 'Druchbereich
Set Kopf = wsP.Range(wsP.Cells(3, 3), wsP.Cells(5, 3)) 'Mitarbeiter-Daten Bereich
Set Daten = wsP.Range(wsP.Cells(8, 1), wsP.Cells(lzP, lsP)) 'Daten Bereich
Set D = wsP.Range(wsP.Cells(8, 4), wsP.Cells(lzP, lsP)) 'Datenbereich Spalte D
Set G = wsP.Range(wsP.Cells(8, 7), wsP.Cells(lzP, lsP)) 'Datenbereich Spalte G

DBer = Druckbereich.Address
DKopf = Kopf.Address
DDaten = Daten.Address
DD = D.Address
DG = G.Address

'Textumbruch aktivieren
'' wsP.Range("DG").Activate 'Textumbruch Spalte D
'' With Selection
'' .WrapText = True
'' End With
'' wsP.Range("DG").Activate 'Textumbruch Spalte G
'' With Selection
'' .WrapText = True
'' End With
wsP.PageSetup.PrintArea = Range(DBer).Address

'PDF-ERSTELLEN
Dim neuerDateiname As String
neuerDateiname = Application.GetSaveAsFilename("\\ifc1.ifr.intra2.admin.ch\Userhomes\" & UserID & "\Desktop\Practical Activities_" & Per & "_" & Vor & "_" & Nach & "_" & Format(Von, "dd.mm.yyyy") & "-" & Format(Bis, "dd.mm.yyyy") & " " & "as per " & Format(Date, "dd.mm.yyyy") & ".pdf", "Adobe PDF-Dateien (*.pdf),*.pdf")
With ActiveWorkbook
wsP.ExportAsFixedFormat _
Type:=xlTypePDF, Filename:=neuerDateiname, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=True, OpenAfterPublish:=False
End With

wsP.Range(DKopf).ClearContents
wsP.Range(DDaten).ClearContents

MsgBox "fertig"

End Sub