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

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

قام بنشر

السلام عليكم

استخدمت القائمة العامودي

تفضل جرب على هذا الرابط


http://www.4shared.com/rar/uwYlbgR3/___1.html

حجم الملف كبير لم يقبل الرفع في المنتدى

قام بنشر

السلام عليكم

تسمية النطاق ليس صحيحا

الكود بعد التصحيح



'كود زر للتنقل بين الشيتات باسماء غير أسمائها

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit

Const mBr As String = "MySheetList"

Sub kh_AddName()

Dim Nam As Range

Dim i As Integer

Dim NamSheet As String

'''''''''''''''''''''''''''''''

On Error GoTo kh_Err

'''''''''''''''''''''''''''''''

kh_BarDelete

'''''''''''''''''''''''''''''''

Set Nam = ورقة32.Range("E2:AH3")

'''''''''''''''''''''''''''''''

With Application.CommandBars.Add(Name:=mBr, Position:=msoBarPopup)

        For i = 1 To Nam.Columns.Count

                NamSheet = Nam.Cells(2, i)

                With .Controls.Add(Type:=msoControlButton)

                        .Caption = Nam.Cells(1, i)

                        .OnAction = "GO_MySheet"

                        .Tag = NamSheet

                        If NamSheet = ActiveSheet.Name Then .State = -1

                        If IsError(Evaluate("'" & NamSheet & "'!A1")) Then

                                .Enabled = False

                        End If

                End With

        Next

End With

'''''''''''''''''''''''''''''''

Application.CommandBars(mBr).ShowPopup

'''''''''''''''''''''''''''''''

kh_Err:

Set Nam = Nothing

If Err Then MsgBox "Err.Number : " & Err.Number

kh_BarDelete

End Sub

Sub kh_BarDelete()

On Error Resume Next

Application.CommandBars(mBr).Delete

On Error GoTo 0

End Sub


Sub GO_MySheet()

Dim N As String

On Error Resume Next

N = Application.CommandBars.ActionControl.Tag

Sheets(N).Activate

End Sub

قام بنشر

أخوتى الأفاضل

السلام عليكم

تعبتكم معايا ألأف شكر لكما

أخى الغالى خبور خير

أخى الغالى أبو نصار

دمتما بود

قام بنشر

للأسف أخوتى الأعزاء لم يفلح الكود وتعديله مع إنى جربته في ملف آخر وتم التنفيذ لكن مش عارف ليه مش شغال على ملفى

  • 4 years later...

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.

×
×
  • اضف...

Important Information