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

• #43221 Pakliman tag ROBOTER #43220

  Új Válasz 2020-03-11 10:25:32 #43221

  Ú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

  

  Pakliman

  tag

  válasz ROBOTER #43220 üzenetére

  Szia!

  Ez alapján elindulhatsz:

  Private Sub Kód_írása_programból()
Dim c As Long

'Új munkafüzet létrehozása
Workbooks.Add

c = Application.VBE.ActiveVBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines

'Az új munkafüzetbe beírunk egy kódot!!!
With Application.VBE.ActiveVBProject.VBComponents("ThisWorkbook").CodeModule
.InsertLines c + 1, "'Ezeket a sorokat programból hoztuk létre!!"
.InsertLines c + 2, "Private Sub Workbook_BeforeClose(Cancel As Boolean)"
.InsertLines c + 4, "End Sub"
End With

End Sub

  Az idézőjelekre kell nagyon odafigyelni, amikor "szöveggé" alakítod a létrehozott programkód sorait:
  sKód = ""
sKód = sKód & vbLf & "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)"
sKód = sKód & vbLf & " Dim TaláltSor"
sKód = sKód & vbLf & " Dim sCrit As String"
sKód = sKód & vbLf & " Dim sÉvHó As String"
sKód = sKód & vbLf & " Dim c"
sKód = sKód & vbLf & ""
sKód = sKód & vbLf & " If Cells(1, Target(1).Column) = ""Név"" Then"
sKód = sKód & vbLf & " Cancel = True"
sKód = sKód & vbLf & " TaláltSor = Application.Match(Cells(ActiveCell.Row, 4), Columns(4), 0)"
sKód = sKód & vbLf & " If Not IsError(TaláltSor) Then"
sKód = sKód & vbLf & " ActiveWindow.ScrollRow = TaláltSor"
sKód = sKód & vbLf & " Cells(TaláltSor, ActiveCell.Column).Activate"
sKód = sKód & vbLf & " End If"
sKód = sKód & vbLf & " Else"
sKód = sKód & vbLf & " If Target(1).Row = 1 Then"
sKód = sKód & vbLf & " For Each c In Range(""A:A"")"
sKód = sKód & vbLf & " If c.Value Like ""T*2#######"" Then"
sKód = sKód & vbLf & " sÉvHó = Left(Right(c, 8), 6)"
sKód = sKód & vbLf & " sÉvHó = Left(sÉvHó, 4) - 1 & Right(sÉvHó, 2)"
sKód = sKód & vbLf & " Exit For"
sKód = sKód & vbLf & " End If"
sKód = sKód & vbLf & " Next c"
sKód = sKód & vbLf & " If sÉvHó <> """" Then"
sKód = sKód & vbLf & " Cancel = True"
sKód = sKód & vbLf & " sCrit = "">="" & sÉvHó"
sKód = sKód & vbLf & " Cells.AutoFilter Field:=Target(1).Column, Criteria1:=sCrit, Operator:=xlAnd"
sKód = sKód & vbLf & " End If"
sKód = sKód & vbLf & " End If"
sKód = sKód & vbLf & " End If"
sKód = sKód & vbLf & "End Sub"
.AddFromString sKód

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