09.07.2019, 12:40
Hallo MicHan
ich freu mich sehr das dir meine Arbeit gefallt, und vor allem das du den VBA Code sofort verstanden hast!! Super!!
Hier noch eine Aendrung für den User aus Blatt "SDMA" automatisch einzufügen. Würde mich freuen wenn es so klappt ...
mfg Gast 123
ich freu mich sehr das dir meine Arbeit gefallt, und vor allem das du den VBA Code sofort verstanden hast!! Super!!
Hier noch eine Aendrung für den User aus Blatt "SDMA" automatisch einzufügen. Würde mich freuen wenn es so klappt ...
mfg Gast 123
Code:
Sub Formel_perVBA_setzen()
Dim AC As Range, xlTxt As String
Dim Jahr As Integer, lz1 As Long
Dim Monat As Variant, i As Integer
Dim Pfad1 As String, Pfad2 As String
Dim Pfad3 As String, Pfad4 As String
Dim Pfad5 As String, Formel As String
Dim FName As String, VName As String
Dim Stg As Worksheet, User As String
Dim SDM As Worksheet 'für User Variable
Set Stg = Worksheets("Settings")
Set SDM = Worksheets("SDMA")
With Worksheets("Stunden_Stats")
lz1 = .Range("A300").End(xlUp).Row
.Range("D4:D200").ClearContents
Pfad1 = Stg.Range("B4").Value
Pfad2 = Stg.Range("B5").Value
Pfad3 = Stg.Range("B6").Value
Pfad4 = Stg.Range("B7").Value
Pfad5 = Stg.Range("B8").Value
Jahr = Stg.Range("B2").Value
Monat = Month(Stg.Range("B1")) & " "
If Len(Monat) = 2 Then Monat = "0" & Monat
xlTxt = ".xlsx]Vorlage'!$A$1:$P$45"
'Laufwerk:\Projekt\Ordner1\*user1*\01 Stundenzettel\2019\[Stundenzettel 2019-01 Mustermann, Lutz.xlsx]Vorlage'!$A$1:$P$45
On Error Resume Next
For Each AC In .Range("A4:A" & lz1)
If AC.Value <> Empty Then
i = i + 1
Formel = Empty 'Text löschen
VName = AC.Cells(1, 2).Value
FName = AC.Cells(1, 3).Value & ", "
User = SDM.Cells(i + 1, "J").Value
Formel = "'=" & Pfad1 & User & Pfad3 & Jahr & "\[Stundenzettel " & Jahr & "-" & Monat & FName & VName & xlTxt
.Cells(AC.Row, 4).FormulaLocal = Formel
End If
Next AC
End With
End Sub