>>658
'何か入力済のセルにオートシェイプで下線を引く
Sub Macro1()
　　For Each c In ActiveSheet.UsedRange
　　　　If c.Text <> "" Then Call セルに下線(c.Row, c.Column)
　　Next
End Sub

Sub セルに下線(r, c)
　　x1 = Cells(1, c).Left
　　x2 = Cells(1, c + 1).Left
　　y1 = Cells(r + 1, 1).Top
　　y2 = y1
　　ActiveSheet.Shapes.AddConnector(msoConnectorStraight, x1, y1, x2, y2).Select
　　With Selection.ShapeRange.Line
　　　　.ForeColor.RGB = RGB(0, 0, 0)　　'黒
　　　　.Weight = 0.75　　'太さpt
　　End With
End Sub