高效快速生成家谱世系图

cunfu2010

cyfx2288 发表于 2017-5-9 16:16
cunfu2010   网友找我要最终版，此论坛中，我没有回复消息的权限，只能在这里回复。
我是边整理家谱，边改 ...

感谢楼主！

cyfx2288

由于代码中存在一个小错误，导致想用此表录入家谱的人，不能直接使用，现已修正。为此我专门去除了我当前多余的数据，做了一个空表，发布到这儿，供想使用此表的人参考。同时也请网友协助制作一个使用说明。最近我事多，偷一个懒。

cyfx2288

zhoudeping 发表于 2017-3-12 22:17
能请教一下填充色具体使用方法？谢谢！！

亲，我后面发的表中，代码是开放的，你查一下就能找到了。

cyfx2288

实际运行中，感觉调用微软自己的 “简转繁” 速度太慢，为此正进行修改，打算自定义一下 “简转繁” 的函数。
另外，打算增加一个按拼音查询的功能。若有新的修改，本人会不定期更新。

cyfx2288

重写了“简转繁” 代码，使用自己定义的GBK表，替换了微软的“简转繁” 。

hhzjxss

看看楼主又有什么新进展

dingboy_VBA

感谢楼主大器分享，我一直在思考这个软件该怎么来做，没想到你已经做出来了并且分享出来了，GREAT!

cyfx2288

家谱表中，为了实现简繁体转换，我用了网上找到的两种方法，结果都不太理想。为此，我稍加修正，写了自己的简繁转换：

Function 简转繁N(strJ As String)
    Dim strF As String                  '繁体字符串
   
    fjMa = fjMa & "H818f,亸,嚲,H8469,刬,剗,H84d6,勚,勩,H85a5,叆,靉,H85a6,叇,靆,H8679,唝,嗊,H867c,唡,啢,H86aa,啰,囉,H86ae,啴,嘽,H8899,垯,墶,"        '01
    fjMa = fjMa & "H889b,垱,壋,H8947,塆,壪,H89d7,壸,壼,H8b4f,婳,嫿,H8cc1,屃,屭,H8d4e,峃,嶨,H8d69,峣,嶢,H8d81,崄,嶮,H8dc2,嵚,嶔,H8ef6,庼,廎,"        '02
    fjMa = fjMa & "H8fa6,彟,彠,H915c,慭,憖,H92a5,挜,掗,H92a6,挦,撏,H9544,旸,暘,H956f,昽,曨,H9783,梼,檮,H9785,梾,棶,H9896,槚,檟,H9b68,沨,渢,"        '03
    fjMa = fjMa & "H9b6d,沵,濔,H9bb8,浉,溮,H9bba,浐,滻,H9bbb,浕,濜,H9be9,涢,溳,H9cbe,溇,漊,H9cf9,滪,澦,Haa41,狝,獮,Hab5f,玙,璵,Hab60,玚,瑒,"        '04
    fjMa = fjMa & "Hab6f,玱,瑲,Hab9a,珰,璫,Hac51,琎,璡,Haf7d,瘆,瘮,Hb180,眬,矓,Hb25a,瞆,瞶,Hb2a2,并,並,Hb36e,硁,硜,Hb37d,硙,磑,Hb37e,硚,礄,"        '05
    fjMa = fjMa & "Hb3f3,丑,醜,Hb574,祎,禕,Hb5ed,淀,澱,Hb68c,秾,穠,Hb6b7,斗,鬥,Hb7b6,范,範,Hb8c9,干,幹,Hb959,筜,簹,Hb982,箓,籙,Hb9b6,苟,苟,"        '06
    fjMa = fjMa & "Hb9c8,谷,穀,Hb9f1,柜,櫃,Hbaf3,后,後,Hbddc,杰,傑,Hbfe4,夸,誇,Hc080,纮,紘,Hc081,纴,紝,Hc082,纻,紵,Hc083,纼,紖,Hc084,绖,絰,"        '07
    fjMa = fjMa & "Hc085,绤,綌,Hc086,绬,緓,Hc087,绹,綯,Hc088,缊,縕,Hc089,缐,線,Hc08a,缞,縗,Hc0ef,里,裡,Hc0fa,历,曆,Hc199,翙,翽,Hc19a,翚,翬,"        '08
    fjMa = fjMa & "Hc1ba,梁,樑,Hc3b4,么,麼,Hc3d0,眯,眯,Hc44e,腘,膕,Hc4c5,呐,呐,Hc548,臜,臢,Hc6cd,仆,僕,Hc751,荙,薘,Hc7a5,钎,釺,Hc7bd,墙,牆,"        '09
    fjMa = fjMa & "Hc85b,萚,蘀,Hc9b2,刹,刹,Hc9c2,陕,陝,Hc9ca,墒,墒,Hc9fd,升,昇,Hcaa5,圣,聖,Hcaac,尸,屍,Hcdbf,涂,塗,Hcddd,洼,窪,Hcf5d,蟏,蠨,"        '10
    fjMa = fjMa & "Hcfc7,锨,鍁,Hcfcc,咸,鹹,Hd084,袆,褘,Hd0ab,蝎,蠍,Hd142,袯,襏,Hd154,裈,褌,Hd25b,襕,襴,Hd35f,觃,覎,Hd360,觍,覥,Hd3bf,涌,湧,"        '11
    fjMa = fjMa & "Hd3da,于,於,Hd3f9,御,禦,Hd480,詟,讋,Hd4b8,愿,願,Hd4c0,岳,嶽,Hd4c6,云,雲,Hd5f7,征,徵,Hd6fe,筑,築,Hd79a,讱,訒,Hd79b,讻,訩,"        '12
    fjMa = fjMa & "Hd79c,诇,詗,Hd79d,诐,詖,Hd79e,诪,譸,Hd7a0,谞,諝,Hd7c9,咨,諮,Hd86b,豮,豶,Hd8ba,睾,睾,Hda4f,贠,貟,Hda50,赑,贔,Hda51,赒,賙,"        '13
    fjMa = fjMa & "Hda52,赗,賵,Hda53,赟,贇,Hda57,赪,赬,Hdaa5,讠,訁,Hdad9,谫,譾,Hdb51,跶,躂,Hdbe0,坂,阪,Hdbe2,垅,壠,Hdbf1,垴,堖,Hdcd0,苄,苄,"        '14
    fjMa = fjMa & "Hdda4,荬,蕒,Hdda7,荮,葤,Hddaf,莜,蓧,Hde61,轪,軑,Hde62,辀,輈,Hde63,辌,輬,Hde64,辒,轀,Hdec1,蘖,蘖,Hdfa6,擀,擀,Hdfb1,弑,弑,"        '15
    fjMa = fjMa & "Hdfc4,吣,唚,Hdfd0,咝,噝,He14e,酦,醱,He1ae,岙,嶴,He1ef,犸,獁,He1f3,狍,麅,He2c5,馀,餘,He2c7,馇,餷,He2cc,馓,饊,He2ce,馕,饢,"        '16
    fjMa = fjMa & "He3c1,懔,懍,He3dc,丬,爿,He4d9,滟,灩,He4f3,潴,瀦,He6f9,纟,糸,He7ab,绔,絝,He7b4,绱,緔,He7eb,珉,瑉,He895,钑,鈒,He896,钖,鍚,"        '17
    fjMa = fjMa & "He897,钘,鈃,He899,铏,鉶,He89a,铓,鋩,He89b,铔,錏,He89c,铚,銍,He89d,铦,銛,He89e,铻,鋙,He89f,锜,錡,He8a0,锠,錩,He8af,璇,璿,"        '18
    fjMa = fjMa & "He8c5,枧,梘,He940,锧,鑕,He941,锳,鍈,He942,锽,鍠,He943,镃,鎡,He944,镈,鎛,He945,镋,钂,He946,镕,鎔,He947,镚,鏰,He948,镠,鏐,"        '19
    fjMa = fjMa & "He949,镮,鐶,He94a,镴,鑞,He94b,镵,鑱,He9cd,橥,櫫,He9ef,轱,軲,He9f5,轷,軤,Hea5c,闬,閈,Hea5d,闿,闓,Hea5e,阇,闍,Hea5f,阓,闠,"        '20
    fjMa = fjMa & "Hea60,阘,闒,Hea61,阛,闤,Heae5,赍,賷,Heaf3,牦,氂,Hebc9,肷,膁,Hebcb,胨,腖,Hebf1,腭,齶,Hecae,飚,飈,Hed82,韨,韍,Hedbf,砜,碸,"        '21
    fjMa = fjMa & "Hedee,眍,瞘,Hedfc,睃,睃,Heed0,钚,鈈,Heede,钷,鉕,Heef4,铘,鋣,Heef6,铞,銱,Hef46,颋,頲,Hef47,颎,熲,Hef48,颒,頮,Hef49,颕,頴,"        '22
    fjMa = fjMa & "Hef4a,颙,顒,Hef4b,颣,纇,Hef72,飏,颺,Hef73,飐,颭,Hef74,飔,颸,Hef75,飖,颻,Hef76,飗,飀,Hefad,锃,鋥,Hefb3,锍,鋶,Hefb4,锎,鉲,"        '23
    fjMa = fjMa & "Hefb5,锏,鐧,Hefbb,锘,鍩,Hefbd,锝,鍀,Hefc1,锪,鍃,Hefc2,锫,錇,Hefcd,锿,鎄,Hefd1,镅,鋂,Hefd5,镎,錼,Hefe3,镢,钁,Hefe5,镥,鑥,"        '24
    fjMa = fjMa & "Hefe9,镩,鑹,Hefef,镲,鑔,Heff9,稆,穭,Hf097,饤,飣,Hf098,饦,飥,Hf099,饳,飿,Hf09a,饸,餄,Hf09b,饹,餎,Hf09c,饻,餏,Hf09d,饾,餖,"        '25
    fjMa = fjMa & "Hf09e,馂,餕,Hf09f,馃,餜,Hf0a0,馉,餶,Hf0c2,鹇,鶓,Hf0c5,鹋,鶓,Hf0cc,鹛,鶥,Hf0d7,鹱,鸌,Hf0df,疬,癧,Hf0e2,疴,痾,Hf0e9,痖,瘂,"        '26
    fjMa = fjMa & "Hf140,馌,饁,Hf141,馎,餺,Hf1d0,裥,襇,Hf1df,襁,繈,Hf1ec,耢,耮,Hf2ac,颥,顬,Hf2b0,虬,虯,Hf2fd,螨,蟎,Hf352,驲,馹,Hf353,骃,駰,"        '27
    fjMa = fjMa & "Hf354,骉,驫,Hf355,骍,騂,Hf356,骎,駸,Hf357,骔,騌,Hf358,骕,驌,Hf359,骙,騤,Hf35a,骦,驦,Hf4d7,糇,餱,Hf5a3,酰,醯,Hf5c5,跖,蹠,"        '28
    fjMa = fjMa & "Hf6d1,鲅,鮁,Hf6d2,鲆,鮃,Hf6d3,鲇,鯰,Hf6df,鲞,鯗,Hf6f1,鲴,鯝,Hf6f5,鲺,鯴,Hf6f7,鲼,鱝,Hf6fd,鳊,鯿,Hf6fe,鳋,鰠,Hf781,鱽,魛,"        '29
    fjMa = fjMa & "Hf782,鱾,魢,Hf783,鲀,魨,Hf785,鲄,魺,Hf786,鲉,鮋,Hf787,鲊,鮓,Hf788,鲌,鮊,Hf789,鲏,鮍,Hf78a,鲓,鮳,Hf78b,鲖,鮦,Hf78c,鲗,鰂,"        '30
    fjMa = fjMa & "Hf78d,鲘,鮜,Hf78e,鲙,鱠,Hf78f,鲝,鮺,Hf790,鲪,鮶,Hf791,鲬,鯒,Hf792,鲯,鯕,Hf793,鲹,鯵,Hf794,鲾,鰏,Hf795,鲿,鱨,Hf796,鳀,鯷,"        '31
    fjMa = fjMa & "Hf797,鳁,鰮,Hf798,鳂,鰃,Hf799,鳈,鰁,Hf79a,鳉,鱂,Hf79b,鳑,鰟,Hf79c,鳒,鰜,Hf79e,鳛,鰼,Hf79f,鳠,鱯,Hf7a0,鳡,鱤,Hf7a1,鳌,鰵,"        '32
    fjMa = fjMa & "Hf7aa,鳘,鰵,Hf7ab,鳙,鱅,Hf7b3,鞒,鞽,Hf7b9,鞴,韝,Hf7e1,麽,麽,Hf7fe,齄,齇,Hf840,鳣,鱣,Hfb5c,鸤,鳲,Hfb5d,鸧,鶬,Hfb5e,鸮,鴞,"        '33
    fjMa = fjMa & "Hfb5f,鸰,鴒,Hfb60,鸴,鴬,Hfb61,鸻,鴴,Hfb62,鸼,鵃,Hfb63,鹀,鵐,Hfb64,鹍,鶤,Hfb65,鹐,鵮,Hfb66,鹒,鶊,Hfb67,鹓,鵷,Hfb68,鹔,鷫,"        '34
    fjMa = fjMa & "Hfb69,鹖,鶡,Hfb6a,鹙,鶖,Hfb6b,鹝,鷊,Hfb6c,鹟,鶲,Hfb6d,鹠,鶹,Hfb6e,鹡,鶺,Hfb6f,鹢,鷁,Hfb70,鹥,鷖,Hfb72,鹯,鸇,Hfb73,鹲,鸏,"        '35
    fjMa = fjMa & "Hfb74,鹴,鸘,Hfc64,黡,黶,Hfc85,鼌,鼂,Hfd86,龁,齕,Hfd87,龂,齗"                                                                     '36     共335字
   
    MyFjMa = Split(fjMa, ",")
    For i = 0 To UBound(MyFjMa) Step 3
        strJ = Replace(strJ, MyFjMa(i + 1), MyFjMa(i))      '替换为内码串
    Next
   
    n = lstrlen(strJ): strF = Space(n)
    LCMapString &H804, &H4000000, strJ, n, strF, n          '简体转繁体
   
    For i = 0 To UBound(MyFjMa) Step 3
        strF = Replace(strF, MyFjMa(i), MyFjMa(i + 2))      '替换为繁体字
    Next
   
   
    简转繁N = strF
End Function

cyfx2288

最近完善了Excel家谱表，真正实现了双谱系查询、录入，适当修改了基础代码，避免直使用列号操作数据表，从而降低代码维护难度。由于刚完成修改，目前尚有一些BUG，待除掉BUG，基本可以稳定使用后，再上传新表。在此之前，先写了一个Excel家谱表使用说明，此说明是针对新版的，使用我以前发布家谱表的，也可参考这个说明，但部分功能或按钮可能对不上。
另外，新版本的家谱表，对成员表中各列的位置、内容都有部分调整，使用过以前旧版本家谱表的，请手工按新版本表调整列位置，并注意修改根节点编号为1，基本就可以直接套用新版本。

cyfx2288

新版家谱表，Excel家谱 交流群 554501178，本人没有精力逐一回复网友的问题，望谅解。请到群里与网友们一起讨论吧。