اذهب الي المحتوي
أوفيسنا

انا جديده هنا واريد المساعده


الردود الموصى بها

 

السلام عليكم ورحمة الله وبركاته 

لدى مشكله لدي خليه بها ارقام تسلسليه ولكنى اريد عند الضغط عليها تظهرلى جميع البيانات الموجوده فى هذا الصف

مثلا خلية الارقام اوريد اضغط عليها فتظهر جميع البيانات فى نفس الصف  

رابط هذا التعليق
شارك

اختي الفاضلة

جربي هذا الملف (نموذج بسيط عما تريدينه)

Select_data_by_columns.rar

الكود فيما يعد لضعف النت

 

 

 

الكود

Sub Select_areas()
Dim mY_rg As Range
Dim last_col%
Set mY_rg = Range("a2").CurrentRegion
mY_rg.Interior.ColorIndex = 0
last_col = Cells(ActiveCell.Row, Columns.Count).End(1).Column
ActiveCell.Resize(, last_col).Interior.ColorIndex = 6
End Sub
'===================================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Application.EnableEvents = False
 On Error Resume Next
  Dim rg As Range
  Set rg = Range("a2").CurrentRegion
  rg.Interior.ColorIndex = 0
 If Target.Column <> 1 Or Target.Count > 1 Or Target = vbNullString Then GoTo 1
Select_areas
1:
 Application.EnableEvents = True
  On Error GoTo 0
End Sub
'

 

  • Like 1
رابط هذا التعليق
شارك

جميل هل يمكن العمل على ان يكون عند تحديد خليه من الصف يلون كل الخلايا التي بها قيم في الصف

 

شكرا استاذنا الفاضل الكود اليس موجود ضمن الملف _ المطور ؟؟؟

 

 

رابط هذا التعليق
شارك

ت

32 دقائق مضت, ظفر الله عسكر said:

جميل هل يمكن العمل على ان يكون عند تحديد خليه من الصف يلون كل الخلايا التي بها قيم في الصف

 

شكرا استاذنا الفاضل الكود اليس موجود ضمن الملف _ المطور ؟؟؟

 

 

تغيير سطر واحد في الكود يقوم بهذا العمل


Sub Select_areas()
Dim mY_rg As Range
Dim last_col%
Set mY_rg = Range("a2").CurrentRegion
mY_rg.Interior.ColorIndex = 0
last_col = Cells(ActiveCell.Row, Columns.Count).End(1).Column
'ActiveCell.Resize(, last_col).Interior.ColorIndex = 6
ActiveCell.Resize(, last_col).SpecialCells(xlCellTypeConstants, 23).Interior.ColorIndex = 6
End Sub
'===================================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Application.EnableEvents = False
 On Error Resume Next
  Dim rg As Range
  Set rg = Range("a2").CurrentRegion
  rg.Interior.ColorIndex = 0
 If Target.Column <> 1 Or Target.Count > 1 Or Target = vbNullString Then GoTo 1
Select_areas
1:
 Application.EnableEvents = True
  On Error GoTo 0
End Sub

 

  • Like 1
رابط هذا التعليق
شارك

شكرا جزيلا جزال الله خيرا

نسخت الكود ولصقته بدل الموجود بقي كما هو 

هل انا اخطأت 

كنت اقصد اذا تم تحديد اية خليه بسطر يقوم بتحديد الخلايا التي تحتوي على قيم في هذا السطر

جزاك الله كل خير

رابط هذا التعليق
شارك

الملف مع التعديل

10 دقائق مضت, ظفر الله عسكر said:

شكرا جزيلا جزال الله خيرا

نسخت الكود ولصقته بدل الموجود بقي كما هو 

هل انا اخطأت 

كنت اقصد اذا تم تحديد اية خليه بسطر يقوم بتحديد الخلايا التي تحتوي على قيم في هذا السطر

جزاك الله كل خير

الملف مع التعديل

 

 

 

Select_data_by_columns_1.rar

  • Like 1
رابط هذا التعليق
شارك

شكرا جزيلا استاذي الغالي والكريم

لعل التعبير خانني بالتوضيح

الكود يعمل اذا تم تحديد خليه بالعمود a
انا كنت اقصد اذا حددنا اية خليه بسطر ما وليس بالضروره في العمود الاول ان تتحدد باقي قيم السطر

شكرا على سعة صدرك

رابط هذا التعليق
شارك

هذا الماكرو

Option Explicit

Sub Select_areas()
Dim mY_rg As Range
Dim last_col%
Dim y%
y = ActiveCell.Column
Set mY_rg = Range("a2").CurrentRegion
last_col = Cells(ActiveCell.Row, Columns.Count).End(1).Column
      With ActiveCell
            If last_col = 1 Then
               .Interior.ColorIndex = 6
               .Borders.LineStyle = 1
             Else
               .Offset(, -y + 1).Resize(, last_col).SpecialCells(2, 23).Interior.ColorIndex = 6
                .Offset(, -y + 1).Resize(, last_col).SpecialCells(2, 23).Borders.LineStyle = 1
           End If
       End With
End Sub
'===================================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Application.EnableEvents = False
 On Error Resume Next
  Dim rg As Range
  Set rg = Range("a2").CurrentRegion
  rg.Interior.ColorIndex = 0
  rg.Borders.LineStyle = 0
If Target.Count > 1 Or Target = vbNullString Then GoTo 1
Select_areas
1:
 Application.EnableEvents = True
  On Error GoTo 0
End Sub
'===================================================
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information