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

كود يغير ارتباط القيم للرسم البياني من الملف القديم الى الملف الجديد عند النسخ


k24s
إذهب إلى أفضل إجابة Solved by الـعيدروس,

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

السلام عليكم 

حين اقوم بنسخ شيت معين "قديم" الى شيت اخر "جديد" باسم محدد من قبل المستخدم عن طريق ( vba) 

 

الشيت القديم (sheet 2)يوجد فيه رسم بياني .. حين يتم انشاء الشيت الجديد ارتباط القيم تعتمد على الشيت القديم كيف اقدر اضع كود يغير ارتباط القيم للرسم البياني من الصفحة الجديدة

الشيت الجديد ( sheet 3 مثلا ) الرسم البياني سيكون مرتبط بصفحة (  sheet 2)  في تغيير البيانات   x أو y لا يوجد اي تغيير على الرسم ( بسبب ارتباطه بصفحة sheet 2 )

 

 

اتمنى من الاخوة الافاضل .. المرور على المرفقات لتتضح الصورة ..  ( يوجد ملف اكسل )

 

اتمنى ان اجد حلاً لتغيير Series الخاصة بالمخطط ضمن الكود الاسفل .. 

 

----------------

1.png.4be3f6431dfa626557c941e04a160347.png3.png.ce2004aded44790ec4e467b5c549bace.png2.png.aa71ef9b342f0545fdf1c9a4d35113c8.png

اعتذر .. 

هذا الملف للفائدة ولبحث حلول حول ذلك ... 

 

Q.xlsm

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

  • أفضل إجابة

السلام عليكم

جرب هذا التعديل على الكود

Private Sub CommandButton1_Click()
    Dim origSht             As Worksheet
    Dim destSht             As Worksheet
    Set origSht = Worksheets("sheet 2")
    sheetsname = InputBox("Enter the sheet name!" & vbNewLine & vbNewLine & "Example:- the sales", "Attention")
    If sheetsname = "" Then
    MsgBox "again please", , "Attention"
    Exit Sub
    End If
    If sheetsname = (Sheets(Sheets.Count).Name) Then
    MsgBox "This Name already Exists", , "Attention"
    Exit Sub
    End If
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = sheetsname
    Set destSht = ActiveSheet
    origSht.Cells.Copy Destination:=destSht.Cells
Dim cr As ChartObject
With destSht
     For Each cr In destSht.ChartObjects
          If cr.Index = 1 Then .ChartObjects(cr.Name).Chart.SetSourceData Source:=.Range("C27,O27:P27")
          If cr.Index = 2 Then .ChartObjects(cr.Name).Chart.SetSourceData Source:=.Range("C28,O28:P28")
     Next cr
End With
End Sub

 

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

الأستاذ

k24s

  أين الضغط على الإعجاب ,طالما أعجبك الحل واعتقد ان هذا اقل ما يقدم لمن كان سبباً فى حل مشكلتك والتفريج عنك ؟!!!!!!!!!!!!

تم تعديل بواسطه أحمد يوسف
  • Thanks 1
رابط هذا التعليق
شارك

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