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

• Delila_1 veterán

  #2589

  #2587 salmiakki

  2015-02-25 12:05:54

  Új Válasz

  Ú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

  

  Delila_1

  veterán

  #2587 salmiakki

  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

  

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