VBA实现打开Excel文件读取内容拷贝Format且加超链接
'-------------------一覧取得-----------------------------
Sub getRedmineGrid_Click()
Dim wb As Workbook
Dim sheet As Worksheet
Dim path As String
path = ThisWorkbook.path & "\issues.xls"
If Dir(path) = "" Then
FileCopy ThisWorkbook.path & "\back\issues.xls", path
Else
FileCopy path, ThisWorkbook.path & "\back\issues.xls"
End If
Dim idx As Integer
idx = 11
Dim csvWb As Workbook
Set csvWb = Workbooks.Open(path)
Set wb = Workbooks("進捗.xlsm")
Set sheet = wb.Sheets("進捗")
sheet.Range("B" & idx & ":Z1000").ClearContents sheet.Range("D6") = Format(Date, "yyyymmdd")
For Each csvSheet In csvWb.Sheets
For i = 2 To 100
If csvSheet.Range("B" & i) = "" Then
Exit For
End If
If csvSheet.Range("B" & i) <> "#" Then
sheet.Range("B" & idx) = csvSheet.Range("B" & i)
sheet.Range("C" & idx) = csvSheet.Range("C" & i)
sheet.Range("D" & idx) = csvSheet.Range("D" & i)
sheet.Range("E" & idx) = csvSheet.Range("E" & i)
sheet.Range("F" & idx) = csvSheet.Range("F" & i)
sheet.Range("G" & idx) = csvSheet.Range("G" & i)
sheet.Range("H" & idx) = csvSheet.Range("H" & i)
sheet.Range("I" & idx) = csvSheet.Range("I" & i)
sheet.Range("J" & idx) = csvSheet.Range("J" & i) sheet.Hyperlinks.Add Anchor:=sheet.Range("B" & idx), Address:="https://XXXXX/" & CStr(sheet.Range("B" & idx))
idx = idx + 1
End If
Next
Next csvWb.Close
Kill path MsgBox "ファイルのデータ取得した。" End Sub '-------------------週状態取得-----------------------------
Sub getLateData_Click() Dim shetName As String
Dim sheet As Worksheet
Dim wb As Workbook
Dim sysDate As String
Dim maxRow As Integer
Dim sheetSample As Worksheet sysDate = Format(Date, "yyyymmdd")
'sysDate7Befor = Format(Date - 7, "yyyymmdd") Set wb = Workbooks("進捗.xlsm")
Set sheet = wb.Sheets("進捗")
Set sheetSample = wb.Sheets("sample")
sysDate7Befor = sheetSample.Range("D6")
shetName = "週(" & sysDate7Befor & "~" & sysDate & ")" maxRow = sheet.Cells.Find("*", , , , xlByRows, xlPrevious).Row
'Sheet1.Cells.Find("*", , , , xlByColumns, xlPrevious).colum If SheetIsExist(wb, shetName) Then Application.DisplayAlerts = False
wb.Sheets(shetName).Delete
Application.DisplayAlerts = True
End If wb.Sheets("sample").Copy after:=wb.Sheets("進捗")
ActiveSheet.Name = shetName
Dim sht As Worksheet
Set sht = wb.Sheets(shetName)
sht.Range("D6") = sysDate7Befor & "~" & sysDate Dim idx As Integer
Dim startRow As Integer
Dim rowColor As String idx = 11
startRow = idx - 3 For i = idx To maxRow
If sheet.Range("B" & i) = "" Then
Exit For
End If If Trim(sysDate7Befor) <= dateToStr(sheet.Range("H" & i)) And dateToStr(sheet.Range("H" & i)) <= sysDate Then
sht.Range("B" & idx) = sheet.Range("B" & i)
sht.Range("C" & idx) = sheet.Range("C" & i)
sht.Range("D" & idx) = sheet.Range("D" & i)
sht.Range("E" & idx) = sheet.Range("E" & i)
sht.Range("F" & idx) = sheet.Range("F" & i)
sht.Range("G" & idx) = sheet.Range("G" & i)
sht.Range("H" & idx) = sheet.Range("H" & i)
sht.Range("I" & idx) = sheet.Range("I" & i)
sht.Range("J" & idx) = sheet.Range("J" & i)
rowColor = ""
If sht.Range("D" & idx) = "終了" Then
rowColor = "back"
End If
Call addStyle(sht, idx, startRow, rowColor)
sht.Hyperlinks.Add Anchor:=sht.Range("B" & idx), Address:="https://XXXXX/" & CStr(sht.Range("B" & idx))
idx = idx + 1
End If
Next sheetSample.Range("D6") = sysDate
End Sub Function dateToStr(str As String)
dateToStr = ""
If str = "" Then
dateToStr = ""
Exit Function
End If
str = Replace(str, "-", "/")
dateToStr = Split(str, "/")(0) If Len(Split(str, "/")(1)) < 2 Then
dateToStr = dateToStr & "0" & Split(str, "/")(1)
Else
dateToStr = dateToStr & Split(str, "/")(1)
End If If Len(Split(str, "/")(2)) < 2 Then
dateToStr = dateToStr & "0" & Split(str, "/")(2)
Else
dateToStr = dateToStr & Split(str, "/")(2)
End If End Function Function SheetIsExist(wbCheck As Workbook, shtNm As String)
SheetIsExist = False
On Error GoTo lab1 Set shetSheet = wbCheck.Sheets(shtNm)
If shetSheet Is Nothing Then
SheetIsExist = False
Else
SheetIsExist = True
End If
Set shetSheet = Nothing
Exit Function lab1:
SheetIsExist = False
End Function
VBA实现打开Excel文件读取内容拷贝Format且加超链接的更多相关文章
- C# 打开TXT文件读取内容
控制关键字,有些关键字发短信发不出来,比如(金融)需要转化为(金.融) 要求:读取敏感字的,并且替换掉 using : using System.Collections.Generic;using S ...
- C#中的Excel操作【1】——设置Excel单元格的内容,打开Excel文件的一种方式
前言 作为项目管理大队中的一员,在公司里面接触最多的就是Excel文件了,所以一开始就想从Excel入手,学习简单的二次开发,开始自己的编程之路! 程序界面 功能说明 打开文件按钮,可以由使用者指定要 ...
- C#读取excel文件的内容(使用DataSet)
C#读取Excel文件的内容,通过OLEDB来连接,关键是连接的路径,如:string strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data S ...
- 麦咖啡阻挡正常打开Excel文件
双击打开Excel文件,提示如下图: Excel文件被麦咖啡做阻挡,无法正常打开 处理方案: 过一会儿还是出现此问题,干脆就把缓冲区保护给禁用掉
- VB中后台打开Excel文件实现代码
某些时候需要打开Excel文件来获取或者写入数据,但又不希望跳出打开的Excel文件窗口,可以用下面的代码: Dim eb As New excel.Application, wb as excel. ...
- 如何在单独的窗口中打开 Excel 文件
如何在单独的窗口中打开 Excel 文件 文章编号:087583 2012/11/1 18:45:29 故障现象: 如何在单独的窗口中打开 Excel 文件? 解决方案: 比较安全的方法就是直 ...
- 用PHPExcel类读取excel文件的内容
这里对PHPExcel类不做介绍,有兴趣的朋友可以自己查阅资料 在classes文件夹下有个PHPExcel.php文件,这个文件是这个类库的主要入口文件,在用之前,要引入这个类 其他的类,在此类中会 ...
- 关于Npoi+excel文件读取,修改文件内容的处理方式
因最近有需求场景,实现对文件的读写操作,又不单独生成新的文件,对于源文件的修改,做了一个简单实现,如下↓ // 要操作的excel文件路径 string fileName = Server.MapPa ...
- vba打开excel文件遍历sheet的名字和指定单元格的值
今天项目上有个应用,获取指定Excel文件下的所有sheet的名称以及当前sheet中指定单元格的值,并把他们写到固定的sheet中去,看了下,文件比较多,而且每个文件sheet的个数比较多,也不一样 ...
随机推荐
- P1025 数的划分——简单题刷傻系列
P1025 数的划分 学傻了,学傻了,什么dp搜索什么啊: #include<cstdio> #include<cstring> #include<algorithm&g ...
- Java基本的线程操作(附代码)
啦啦啦啦,从头整理一遍java并发的内容.开始是基本的线程操作 线程状态切换: 新建线程: @Test public void newTread(){ Thread t1 = new Thread(n ...
- Python接口自动化测试(一)什么是接口?
接口:API(Application Programming Interface)即应用程序接口.你可以认为API是一个软件组件,或是一个Web服务与外界进行交互的接口. 1.从功能层面上 可以将接口 ...
- yarn-site.xml 基本配置参考
以下只是对yarn配置文件(yarn.site.xml)简单的一个配置 <configuration> <!-- rm失联后重新链接的时间 --> <property&g ...
- Apache日志详解
在渗透测试的工作中,WEB网站的日志是非常重要的,今天总结了一些关于调配Apache日志的一些东西. 0x00 Apache日志文件名称及路径介绍 我们安装好Apache后,Apache的配置文件(h ...
- 走进JavaWeb技术世界11:单元测试框架Junit
JUnit你不知道的那些事儿 转自 老刘 码农翻身 2016-02-24 话说有一次Eric Gamma 坐飞机的时候偶遇Kent Beck(对,就是极限编程和TDD的发起人) , 两位大牛见面寒暄 ...
- Git git rm和git rm --cached
git rm 和 git rm --cached 的区别 git rm file git commit -m "xxx" git push origin master 删除本地及仓 ...
- OpenResty之ngx.shared.DICT
参考链接: resty.core.shdict ngx_shared.DICT 源码正文: dict.lua 部分源码如下: local ffi = require 'ffi' local base ...
- SDK/JDK,Shell/Shell脚本,Apache/APR ,MTK
SDK 软件开发工具包(SoftwareDevelopmentKit) API(Application Programming Interface,应用编程接口)其实就是操作系统留给应用程序的一个调用 ...
- arcgis python 发送邮件
import arcgisscripting, smtplib, os, sys, traceback from email.MIMEMultipart import MIMEMultipart fr ...