使用VBA将工作表单元格中的图片链接至页眉左侧区域

要让sht__Infos工作表中Cel__Logo单元格的图片和页眉左侧的图片自动同步，Excel没有原生的"链接"功能，得通过VBA实现双向同步。下面是具体方案：

一、修改插入图片的宏，同步更新页眉 #

修改你现有的Center_Resize_Image宏，在调整完单元格图片后，自动将图片同步到页眉左侧。这样每次插入/调整单元格图片时，页眉会跟着更新：

' Center_Resize_Image
Public Sub Center_Resize_Image()
    On Error Resume Next
    Dim result As Boolean
    result = Application.Dialogs(xlDialogInsertPicture).Show
    On Error GoTo 0

    If Not result Then
        Exit Sub
    End If

    Dim selectedShape As Shape
    Set selectedShape = Selection.ShapeRange.Item(1)

    Dim widthInput As Variant
    widthInput = InputBox("Enter width (default is 4.5cm):", , 4.5)
    Dim heightInput As Variant
    heightInput = InputBox("Enter height (default is 3cm):", , 3)

    Dim widthValue As Double
    widthValue = IIf(IsNumeric(widthInput) And widthInput <> "", CDbl(widthInput), 4.5)
    Dim heightValue As Double
    heightValue = IIf(IsNumeric(heightInput) And heightInput <> "", CDbl(heightInput), 3)

    selectedShape.LockAspectRatio = msoFalse
    selectedShape.Height = Application.CentimetersToPoints(heightValue)
    selectedShape.Width = Application.CentimetersToPoints(widthValue)

    Dim myActiveCell As Range
    Set myActiveCell = ActiveCell

    ' 将图片定位到单元格中心
    With selectedShape
        .Top = myActiveCell.Top + (myActiveCell.Height - .Height) / 2
        .Left = myActiveCell.Left + (myActiveCell.Width - .Width) / 2
        ' 标记图片属于Cel__Logo单元格，方便后续识别
        .Name = "Cel__Logo_Image"
    End With

    myActiveCell.Select

    ' 同步图片到页眉左侧
    SyncLogoToHeader
End Sub

' 同步Cel__Logo单元格的图片到页眉左侧
Private Sub SyncLogoToHeader()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("sht__Infos")
    Dim logoShape As Shape
    Dim headerShape As Shape

    ' 先删除页眉中旧的Logo（如果存在）
    On Error Resume Next
    Set headerShape = ws.Shapes("Header_Cel__Logo")
    If Not headerShape Is Nothing Then headerShape.Delete
    On Error GoTo 0

    ' 获取Cel__Logo单元格中的图片
    Set logoShape = ws.Shapes("Cel__Logo_Image")
    If logoShape Is Nothing Then Exit Sub

    ' 复制图片到页眉区域
    logoShape.Copy
    ws.Paste
    Set headerShape = ws.Shapes(ws.Shapes.Count)

    ' 设置页眉图片的位置和尺寸（左侧页眉区域）
    With headerShape
        .Name = "Header_Cel__Logo"
        .Top = ws.PageSetup.TopMargin - .Height ' 定位到页眉顶部
        .Left = ws.PageSetup.LeftMargin ' 定位到左侧
        .LockAspectRatio = msoFalse
        .Height = logoShape.Height
        .Width = logoShape.Width
        .Placement = xlMoveAndSize ' 确保和页眉关联
        .Visible = True
    End With
End Sub

二、添加工作表事件，实现自动同步 #

如果直接修改Cel__Logo单元格里的图片（比如替换、调整大小），需要触发自动同步。打开VBA编辑器，找到sht__Infos工作表，粘贴以下事件代码：

Private Sub Worksheet_ShapeChanged(ByVal Sh As Shape)
    ' 当Cel__Logo单元格的图片被修改时，同步到页眉
    If Sh.Name = "Cel__Logo_Image" Then
        SyncLogoToHeader
    End If
End Sub

三、使用说明 #

1. 运行Center_Resize_Image宏插入图片到Cel__Logo单元格时，页眉左侧会自动生成同步的图片；
2. 直接修改Cel__Logo单元格里的图片（比如调整大小、替换图片），页眉的图片会自动更新；
3. 如果需要替换图片，直接删除原图片后重新运行宏即可，页眉会同步更新。

注意：确保Cel__Logo单元格是命名单元格，且每次插入的图片都会被标记为Cel__Logo_Image，这样事件才能准确识别。

内容的提问来源于stack exchange，提问作者Jawad