由于经常要画双轴图，常常碰到左轴有负数，右轴没有负数，希望将0轴坐标对齐。当然，一个图的话手工改就可以了，如果每个月都要画上百个呢？所以想到用vba自动调整，查了网上资料，很少这方面的专题文章。经摸索，初步写了一些代码，可能还有进一步优化的空间，权当抛砖引玉。以下用excel控制双轴图、用access控制双轴图、用access打开excel并控制其双轴图三种方法进行列举比较，与大家分享。

一：用excel调整双轴图

Private Sub CommandButton2_Click()

ChartObjects("图表 1").Activate

With ActiveChart.Axes(xlValue)               

                ccc = .MajorUnit   '左轴间距

                aaa = .MaximumScale '左轴最大值

                bbb = .MinimumScale '左轴最小值

End With

With ActiveChart.Axes(xlValue, xlSecondary)

.MinimumScaleIsAuto = True

.MaximumScaleIsAuto = True

.MajorUnitIsAuto = True

                aa2 = .MaximumScale    '右轴最大值

                Call mm(aaa, bbb, ccc, aa2, aa3, aa4)    'aa左大 bb左小 cc左距 aa2右大 aa3右小 aa4右间距

End Sub

 

Sub mm(aa, bb, cc, dd, ee, aa4) 'aa左大 bb左小 cc左距 dd右大 ee右小 aa4右间距

If bb > 0 Then bb = 0

ff = dd * 10 Mod (aa / cc)

If ff = 0 Then ff = aa / cc

dd = dd + ff / 10

If dd > (2 * aa / cc) Then

aa4 = Round(dd / (aa / cc), 0)

Else

aa4 = Round(dd / (aa / cc), 1)

End If

dd = aa4 * (aa / cc)

ee = dd * bb / aa

 

End Sub

 

二：用access调整双轴图

Private Sub Command3_Click()

 

With Me![Graph1].axes(2, 2)

 .MinimumScaleIsAuto = True

 .MaximumScaleIsAuto = True

 .majorunitisauto = True

End With

 

With Me![Graph1].axes(2)

cc = .majorunit

aa = .maximumscale

bb = .minimumscale

End With

 

With Me![Graph1].axes(2, 2)

 aa2 = .maximumscale

 Call mm(aa, bb, cc, aa2, aa3, aa4)

 .minimumscale = aa3

 .maximumscale = aa2

 .majorunit = aa4

End With

End Sub

Sub mm(aa, bb, cc, dd, ee, aa4) 'aa左大 bb左小 cc左距 dd右大 ee右小 aa4右间距

‘与excel的子程序一样，这里就不重复了

End Sub

 

三：用access调整excel双轴图

 

Private Sub Command7_Click()

    Set xlApp = CreateObject("Excel.Application")    '打开文件

    Set xlBook = xlApp.Workbooks.Open(CurrentProject.Path & "\双轴图.xls")

 

    With xlBook.Application.Sheets(1).Chartobjects("图表 1").chart

 

 

        ccc = .axes(2).majorunit   '左轴间距

        aaa = .axes(2).maximumscale '左轴最大值

        bbb = .axes(2).minimumscale '左轴最小值

        aa2 = .axes(2, 2).maximumscale    '右轴最大值

 

 

        Call mm(aaa, bbb, ccc, aa2, aa3, aa4)    'aa左大 bb左小 cc左距 aa2右大 aa3右小 aa4右间距

 

 

   Set xlApp = Nothing

End Sub

 

Sub mm(aa, bb, cc, dd, ee, aa4) 'aa左大 bb左小 cc左距 dd右大 ee右小 aa4右间距

‘与excel的子程序一样，这里就不重复了

End Sub

 

    结论：思路是一样的，只要看sub mm()就知道了，只是各自的语法有点差别。