Delphi7操作Excel读取数据有效性检查下拉列表内容?Formula属性

uses
comobj; //需要引用单元

procedure WriteToExcel(str_filename:string); //读取原来的Excel单元格的下拉列表,自动填写
var
ExcelApp, Workbook, Sheet,SheetHidden: OleVariant;
Range: OleVariant;
i,j,i_max: Integer;
str_spec,str_spec2: string;
strlst,strlst2: TStringList;
str_formula: string;
hnd: THandle;
begin
if FileExists(str_filename) then
begin
try
ExcelApp := CreateOleObject('Excel.Application'); // 创建Excel应用程序实例
try
Workbook := ExcelApp.Workbooks.Open(str_filename); // 打开已存在的Excel文件 规格,型号,款式
try
ExcelApp.WorkSheets[1].Activate;
Sheet := Workbook.Worksheets[1]; // 获取第一个工作表
str_spec := 'A|B|C|D|E|F|G|H|I'; //每个规格填写不通的型号、款式,型号、款式不能重复,且有数据有效性检查
i_max := Sheet.UsedRange.Columns.Count;

      strlst:= TStringList.Create;
      strlst2:= TStringList.Create;
      SplitList(strlst, str_spec,'|');
      if (i_max>1) then
      begin
        for i:=1 to Sheet.UsedRange.Columns.Count do
        begin
          str_spec :=  Sheet.Cells[3,i].value;
          if str_spec = '' then break;
          range := Sheet.Range[Sheet.Cells[4,i],Sheet.Cells[4,i]];   //先取得range!!!!
          str_formula := range.Validation.Formula1;                  //关键这句!!!!!取得数据有效性检查下拉列表内容!!
          if Pos('hidden', str_formula)>0 then
          begin
            SheetHidden := Workbook.Worksheets[2];   //第二个工作表隐藏的,是款式的下拉列表内容
            strlst2.Clear;
            for j:=1 to SheetHidden.UsedRange.Rows.Count do
              strlst2.Add(SheetHidden.Cells[j,1].value);
            j := 0;  
          end
          else
          if (Pos(',', str_formula)>0) and (pos('COUNT',str_formula)=0)  then
          begin
            str_formula := StringReplace(str_formula, '"', '', [rfReplaceAll]);  //型号的下拉列表内容
            SplitList(strlst2, str_formula,',');
          end;
          if Sheet.Cells[3,i].Font.Color = clRed then
          begin
            for j:=0 to strlst.count-1 do
            begin
              if i=1 then
                Sheet.Cells[j+4, i] := strlst[j]
              else         
              begin
                if strlst2.count > j then
                  Sheet.Cells[j+4, i] := strlst2[j]     //其他必填项下拉列表,第几行自动填写第几个下拉值,保证不重复!
                else
                  Sheet.Cells[j+4, i] := IntTostr(j+1);
              end;
            end;
          end;
        end;
      end
      else
      begin
        for i:=0 to strlst.Count-1 do
        begin
          Sheet.Cells(Sheet.UsedRange.Rows.Count + 1, 1) := strlst[i];     // 追加内容到工作表的末尾
        end;
      end;

      Workbook.Save;       // 保存更改
    finally
      Workbook.Close();
      Workbook := Unassigned;
    end;
  finally     
    strlst.Free;
    strlst2.Free;
    ExcelApp.Quit;
    ExcelApp := Unassigned;

    str_filename := ExtractFileName(str_fileName);
    hnd:=FindWindow(nil,PAnsiChar(str_filename));  //没有关闭掉的话,再根据句柄再关闭一次
    if IsWindow(hnd) then
      SendMessage(hnd,WM_CLOSE,0,0);
  end;
except
  on E: Exception do
    showmessage('Error occurred: ' + E.Message);
end;

end;
end;

调用:
WriteToExcel('d:/abc.xlsx');

posted @   德尔菲殿堂  阅读(14)  评论(0编辑  收藏  举报
相关博文:
阅读排行:
· 震惊!C++程序真的从main开始吗?99%的程序员都答错了
· 【硬核科普】Trae如何「偷看」你的代码?零基础破解AI编程运行原理
· 单元测试从入门到精通
· 上周热点回顾(3.3-3.9)
· winform 绘制太阳,地球,月球 运作规律
点击右上角即可分享
微信分享提示