لینک سل به Header

[Amin_D]

با سلام

با چه ترفندی میشه یه سل رو Header فرم لینک کرد

[generalsamad]

با سلام
میتونید از این دو کد استفاده کنید
من دو کد رو در قالب دکمه آوردم که با کلیک روی دکمه محدوده Header یا Footer رو انتخاب میکنید
کد زیر برای Footer

Private Sub CommandButton1_Click()
Dim WorkRng As Range
On Error Resume Next
xTitleId = "Footer"
Set WorkRng = Application.Selection.Range("A1")
Set WorkRng = Application.InputBox("Range (single cell)", xTitleId, WorkRng.Address, Type:=8)
For Each ws In Application.ActiveWorkbook.Worksheets
    ws.PageSetup.LeftFooter = WorkRng.Range("A1").Value
Next
End Sub 

کد زیر برای Header

Private Sub CommandButton2_Click()
Dim WorkRng As Range
On Error Resume Next
xTitleId = "Header"
Set WorkRng = Application.Selection.Range("A1")
Set WorkRng = Application.InputBox("Range (single cell)", xTitleId, WorkRng.Address, Type:=8)
For Each ws In Application.ActiveWorkbook.Worksheets
    ws.PageSetup.LeftHeader = WorkRng.Range("A1").Value
Next
End Sub 

منبع:http://www.extendoffice.com/

[majid_mx4]

با سلام

ضمن تشکر از دوست بیسار خوبم جناب generalsamad ( که البته دستور ایشان برای تمامی شیت ها می باشد ولی این دستور برای یک شیت می باشد ) میتوانید از دستور زیر استفاده نمایید

Sub headerofactivesheet()
 ActiveSheet.PageSetup.CenterHeader = Range("a1").Value
 End Sub

و یا

Private Sub Workbook_BeforePrint(Cancel As Boolean)
 With ActiveSheet
 .PageSetup.CenterFooter = .Range("A1").Text
 End With
 End Sub

با تشکر

[generalsamad]

ضمن تشکر از دوست عزیز majid_mx4 علاوه بر کدهای بالا میشه از کد زیر نیز استفاده کرد
کد بالائی که نوشتم یه ایرادی داشت
ایرادش این بود که اگه متن سلول تغییر میکرد Header یا Footer آپدیت نمیشد
این کد رو میتونید تو قسمت This Workbook وارد کنید
توجه: تفاوتی که داره اینه آپدیت میشه ولی توی نمایش نشون داده نمیشه ولی توی پرینت اعمال میشه

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim WS As Worksheet
For Each WS In Worksheets
    WS.PageSetup.LeftHeader = Worksheets("Sheet1").Range("A1").Value
Next WS
End Sub 

فایل ضمیمه گردید