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

• #2589 Delila_1 veterán salmiakki #2587

  Új Válasz 2015-02-25 12:05:54 #2589

  Ú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

  

  Delila_1

  veterán

  válasz salmiakki #2587 üzenetére

  A lenti makró az újonnan betett objektum helyzetét vizsgálja, de csak az előtte berakott utolsóhoz képest. Ha az utolsó előttit takarja, üzenetet küld. Az ábrán kiemelt rész mutatja, hogy olyan esetben is jelez, ha látszólag nincs takarás, de a valóságban igen.

  Sub Takar_e()
  Dim elozo As Integer
  Dim B_uj As Single, J_uj As Single, F_uj As Single, A_uj As Single
  Dim B_elozo As Single, J_elozo As Single, F_elozo As Single, A_elozo As Single
  Dim Vizsz As Boolean, Fugg As Boolean
  
  Vizsz = False: Fugg = False
  
  'Új alakzat adatai
  With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
  B_uj = .Left 'bal szél
  J_uj = .Left + .Width 'jobb szél
  F_uj = .Top 'felső pont
  A_uj = .Height + .Top 'alsó pont
  End With
  
  'Előző alakzat adatai
  elozo = ActiveSheet.Shapes.Count - 1
  With ActiveSheet.Shapes(elozo)
  B_elozo = .Left 'bal szél
  J_elozo = .Left + .Width 'jobb szél
  F_elozo = .Top 'felső pont
  A_elozo = .Top + .Height 'alsó pont
  End With
  
  If B_uj >= B_elozo And B_uj <= J_elozo Then Vizsz = True
  If J_uj >= B_elozo And J_uj <= J_elozo Then Vizsz = True
  If F_uj >= F_elozo And F_uj <= A_elozo Then Fugg = True
  If A_uj >= F_elozo And A_uj <= A_elozo Then Fugg = True
  
  If Vizsz = True And Fugg = True Then
  MsgBox "Az előző (" & ActiveSheet.Shapes(elozo).Name & " nevű) objektum takarásban van", vbExclamation
  Else: MsgBox "Nincs takarásban az előző objektum"
  End If
  End Sub

  

  [ Szerkesztve ]

  Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

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