Új hozzászólás Aktív témák

• #53287 tomi_x tag Fferi50 #53286

  Új Válasz 2024-09-26 20:41:11 #53287

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  tomi_x

  tag

  válasz Fferi50 #53286 üzenetére

  Ez volna az:
  Private Sub CommandButton1_Click()
Dim mappanev As String
Dim fso As Scripting.FileSystemObject
Dim WSNET As Object
Dim mappanev2 As String
Dim mappanev3 As String
Dim arajanlatnev As String
Dim fajl As Variant
Dim bekernev As String
Dim sablonnev As String
Dim keszito As String
Dim megrendelo As String
Dim kapcsolat As String
Dim ugyfel As String
Dim bekernev2 As String
mappanev = Cells(11, 11).Value & Cells(10, 11).Value

Set fso = CreateObject("Scripting.FileSystemObject")
Set WSNET = CreateObject("WScript.Network")
mappanev2 = mappanev & "\Árajánlat"
mappanev3 = mappanev & "\Kapott anyag"
arajanlatnev = mappanev2 & "\" & Cells(9, 12).Value & ".xlsm"
bekernev = mappanev2 & "\" & Cells(13, 12).Value & ".xlsm"
Cells(9, 13).Value = arajanlatnev
Cells(13, 13).Value = bekernev
sablonnev = Cells(14, 11).Value
If Cells(9, 14).Value < 253 Then
If fso.FolderExists(mappanev) = True Then
MsgBox "A könyvtár létezik az adott könyvtárba" & vbNewLine & "Nyisd meg a meglévő árajánlatot !"
Else
fso.CreateFolder mappanev
fso.CreateFolder mappanev2
fso.CreateFolder mappanev3
'MsgBox "Mappák létrehozva." & vbNewLine & mappanev & vbNewLine & mappanev2 & vbNewLine & mappanev3
'árajánlat mentése másként
ActiveWorkbook.SaveCopyAs Filename:=arajanlatnev
Workbooks.Open Filename:=arajanlatnev

keszito = Cells(4, 3).Value
megrendelo = Cells(3, 8).Value
kapcsolat = Cells(4, 8).Value
ugyfel = Cells(8, 8).Value
MsgBox "Az Ok gomb megnyomása után tallózd ki az önköltségi sablon táblázatot !"
fajl = Application.GetOpenFilename _
(FileFilter:="Excel makróbarát fájlok, *.xlsm")
If fajl = False Then
'Cancel gombot nyomták meg
Exit Sub
End If
Workbooks.Open Filename:=fajl
ActiveWorkbook.SaveCopyAs Filename:=bekernev
ActiveWorkbook.Close
Workbooks.Open Filename:=bekernev
Sheets(2).Activate
bekernev2 = Cells(13, 16) '"'" & mappanev2 & "\" & Cells(13, 12).Value & ".xlsm" & "'"
'Workbooks(bekernev).Activate
ActiveWorkbook.Cells(13, 3).Value = megrendelo
End If
Else
MsgBox "Túl hosszú file név !" & vbNewLine & "A Projekt megnevezése mezőt tudod módosítani !"
End If
End Sub

  Sharepointon lévő mappákból, mappákba dolgozna a makró.
  A mappákat, a file-ok másolatait rendben megcsinálja.
  Akkor akad el amikor adatot szeretnék az egyik új file cellájába (ActiveWorkbook.Cells(13, 3).Value = megrendelo).

Új hozzászólás Aktív témák